--- rpl/src/gestion_pile_systeme.c	2013/02/27 17:11:40	1.50
+++ rpl/src/gestion_pile_systeme.c	2013/03/05 16:20:47	1.51
@@ -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).pointeur_adresse_retour = NULL;
 	(*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'N';
 	(*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL;
@@ -302,16 +303,20 @@ effacement_pile_systeme(struct_processus
 void
 trace(struct_processus *s_etat_processus, FILE *flux)
 {
-	integer8						i;
-	integer8						candidat;
+	int								candidat;
+	int								j;
+	int								nb_variables;
 
-	long							delta;
+	integer8						i;
+	integer8						candidat8;
+	integer8						delta;
 
-	struct_liste_chainee			*l_variable;
-	struct_liste_chainee			*l_candidat;
+	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;
@@ -326,6 +331,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");
@@ -333,181 +349,328 @@ trace(struct_processus *s_etat_processus
 
 	while(l_element_courant != NULL)
 	{
-		fprintf(flux, "%d : (%016X) 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, "RTN ");
+			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;
+
+				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;
+
+				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;
+			}
+		}
 
-				if ((*l_element_courant).adresse_retour != 0)
+		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, "    Return            = yes\n");
+
+			if ((*l_element_courant).origine_routine_evaluation == 'Y')
+			{
+				if ((*l_element_courant).pointeur_objet_retour != NULL)
 				{
-					fprintf(flux, "P=%016X", (*l_element_courant)
-							.adresse_retour);
+					fprintf(flux, "    Come from         = compiled code ");
+					fprintf(flux, "(address # %016Xh)\n", (*l_element_courant)
+							.pointeur_objet_retour);
 
 					// Calcul de la routine de départ
 
-					l_variable = (struct_liste_chainee *)
-							(*(*(*s_etat_processus)
-							.l_liste_variables_par_niveau).precedent).liste;
-					candidat = (*s_etat_processus)
-							.longueur_definitions_chainees;
-					l_candidat = NULL;
-
-					// l_variable balaie les variables de niveau 0.
+					candidat = -1;
 
-					while(l_variable != NULL)
+					for(j = 0; j < nb_variables; j++)
 					{
-						if ((*(*((struct_variable *) (*l_variable).donnee))
-								.objet).type == ADR)
+						if (((*(tableau[j].objet)).type == RPN) ||
+								((*(tableau[j].objet)).type == ALG))
 						{
-							delta = (*l_element_courant).adresse_retour
-									- (*((unsigned long *)
-									(*(*((struct_variable *) (*l_variable)
-									.donnee)).objet).objet));
+							l_element_expression = (*(tableau[j].objet)).objet;
 
-							if ((delta > 0) && (delta < candidat))
+							while(l_element_expression != NULL)
 							{
-								candidat = delta;
-								l_candidat = l_variable;
+								if (l_element_expression == (*l_element_courant)
+										.pointeur_objet_retour)
+								{
+									candidat = j;
+									break;
+								}
+
+								l_element_expression =
+										(*l_element_expression).suivant;
 							}
-						}
 
-						l_variable = (*l_variable).suivant;
+							if (candidat != -1)
+							{
+								break;
+							}
+						}
 					}
 
-					if (l_candidat != NULL)
+					if (candidat != -1)
 					{
-						fprintf(flux, "\n  Call from %s",
-								(*((struct_variable *) (*l_candidat).donnee))
-								.nom);
+						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, "\n  Call from RPL/2 initialization");
+						fprintf(flux, "                      = "
+								"optimized definition\n");
 					}
 				}
 				else
 				{
-					fprintf(flux, "RPL/2 initialization");
+					fprintf(flux, "                      = "
+							"optimized definition\n");
 				}
 			}
-		}
-		else
-		{
-			fprintf(flux, "NONE ");
-
-			if ((*l_element_courant).origine_routine_evaluation == 'Y')
-			{
-				fprintf(flux, "EVL ");
-			}
 			else
 			{
-				fprintf(flux, "SEQ ");
+				fprintf(flux, "    Come from         = interpreted code ");
 
-				if ((*l_element_courant).pointeur_adresse_retour != NULL)
+				if ((*l_element_courant).adresse_retour != 0)
 				{
-					fprintf(flux, "A=%016X ", (*l_element_courant)
-							.pointeur_adresse_retour);
+					fprintf(flux, "(offset # %016Xh)\n", (*l_element_courant)
+							.adresse_retour);
 
 					// Calcul de la routine de départ
 
-					l_variable = (struct_liste_chainee *)
-							(*(*(*s_etat_processus)
-							.l_liste_variables_par_niveau).precedent).liste;
-					candidat = (*s_etat_processus)
+					candidat8 = (*s_etat_processus)
 							.longueur_definitions_chainees;
-					l_candidat = NULL;
-
-					// l_variable balaie les variables de niveau 0.
+					candidat = -1;
 
-					while(l_variable != NULL)
+					for(j = 0; j < nb_variables; j++)
 					{
-						if ( (*(*l_variable).donnee).objet ==
-								(*l_element_courant).pointeur_adresse_retour)
+						if ((*(tableau[j].objet)).type == ADR)
 						{
-							l_candidat = l_variable;
-							break;
-						}
+							delta = (*l_element_courant).adresse_retour
+									- (*((unsigned long *)
+									(*(tableau[j].objet)).objet));
 
-						l_variable = (*l_variable).suivant;
+							if ((delta >= 0) && (delta < candidat8))
+							{
+								candidat8 = delta;
+								candidat = j;
+							}
+						}
 					}
 
-					if (l_candidat != NULL)
+					if (candidat != -1)
 					{
-						fprintf(flux, "\n  Branch to %s",
-								(*((struct_variable *) (*l_candidat).donnee))
-								.nom);
+						fprintf(flux, "                      = %s\n",
+								tableau[candidat].nom);
 					}
 					else
 					{
-						fprintf(flux, "\n  Branch to evaluation subroutine");
+						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;
 }