--- rpl/src/formateur.c	2010/05/24 10:58:30	1.12
+++ rpl/src/formateur.c	2013/03/16 20:11:29	1.57
@@ -1,7 +1,7 @@
 /*
 ================================================================================
-  RPL/2 (R) version 4.0.16
-  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"
 
 
 /*
@@ -47,6 +47,8 @@ formateur(struct_processus *s_etat_proce
 	logical4					autorisation_parenthese;
 	logical4					presence_signe;
 
+	long						longueur_chaine;
+
 	struct_liste_chainee		*l_atome;
 	struct_liste_chainee		*l_element_courant;
 	struct_liste_chainee		*l_liste1;
@@ -67,15 +69,12 @@ formateur(struct_processus *s_etat_proce
 	unsigned char				*format_majuscule;
 	unsigned char				*ptre;
 	unsigned char				*ptrl;
-	unsigned char				*ptr_ecriture;
-	unsigned char				*ptr_lecture;
 	unsigned char				*registre;
 	unsigned char				tampon[1024 + 1];
 
 	unsigned long				i;
 	unsigned long				j;
 	unsigned long				k;
-	unsigned long				longueur_binaire;
 	unsigned long				longueur_courante;
 	unsigned long				longueur_decimale_courante;
 	unsigned long				*longueurs_maximales;
@@ -94,7 +93,6 @@ formateur(struct_processus *s_etat_proce
 
 	strcpy(base, " ");
 
-	longueur_binaire = 0;
 	masque_binaire = 0;
 
 	if ((*s_objet).type == ADR)
@@ -392,7 +390,7 @@ formateur(struct_processus *s_etat_proce
 --------------------------------------------------------------------------------
 */
 
-		if (alsprintf(&chaine, "Socket %016lX",
+		if (alsprintf(&chaine, "Socket $ %016lX",
 				(unsigned long) (*((struct_socket *)
 				((*s_objet).objet))).socket) < 0)
 		{
@@ -1580,7 +1578,6 @@ formateur(struct_processus *s_etat_proce
 --------------------------------------------------------------------------------
 */
 
-		longueur_binaire = longueur_entiers_binaires(s_etat_processus);
 		masque_binaire = masque_entiers_binaires(s_etat_processus);
 
 		if ((test_cfsf(s_etat_processus, 43) == d_faux) &&
@@ -1752,80 +1749,25 @@ formateur(struct_processus *s_etat_proce
 --------------------------------------------------------------------------------
 */
 
-		if ((chaine = malloc((strlen((unsigned char *)
-				((*s_objet).objet)) + 1) * sizeof(unsigned char))) == NULL)
-		{
-			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
-			return(NULL);
-		}
-
-		if ((*s_etat_processus).autorisation_conversion_chaine == 'Y')
+		if (((*s_etat_processus).autorisation_conversion_chaine == 'Y') &&
+				(test_cfsf(s_etat_processus, 34) == d_vrai))
 		{
-			ptr_lecture = (unsigned char *) (*s_objet).objet;
-			ptr_ecriture = chaine;
-
-			while((*ptr_lecture) != d_code_fin_chaine)
+			if ((chaine = formateur_flux(s_etat_processus,
+					(unsigned char *) (*s_objet).objet, &longueur_chaine))
+					== NULL)
 			{
-				(*ptr_ecriture) = (*ptr_lecture);
-
-				// Début de la séquence d'échappement
-
-				if ((*ptr_lecture) == '\\')
-				{
-					if ((*(ptr_lecture + 1)) == '"')
-					{
-						ptr_lecture++;
-						(*ptr_ecriture) = '\"';
-					}
-					else if ((*(ptr_lecture + 1)) == 'b')
-					{
-						ptr_lecture++;
-						(*ptr_ecriture) = '\b';
-					}
-					else if ((*(ptr_lecture + 1)) == 'n')
-					{
-						ptr_lecture++;
-						(*ptr_ecriture) = '\n';
-					}
-					else if ((*(ptr_lecture + 1)) == 't')
-					{
-						ptr_lecture++;
-						(*ptr_ecriture) = '\t';
-					}
-					else if ((*(ptr_lecture + 1)) == '\\')
-					{
-						ptr_lecture++;
-					}
-					else
-					{
-						if ((*s_etat_processus).langue == 'F')
-						{
-							printf("+++Information : Séquence d'échappement "
-									"inconnue [%d]\n", (int) getpid());
-						}
-						else
-						{
-							printf("+++Warning : Unknown escape code "
-									"[%d]\n", (int) getpid());
-						}
-					}
-				}
-
-				ptr_ecriture++;
-			   	ptr_lecture++;
-			}
-
-			(*ptr_ecriture) = d_code_fin_chaine;
-
-			if ((chaine = realloc(chaine, (strlen(chaine) + 1) *
-					sizeof(unsigned char))) == NULL)
-			{
-				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 				return(NULL);
 			}
 		}
 		else
 		{
+			if ((chaine = malloc((strlen((unsigned char *)
+					((*s_objet).objet)) + 1) * sizeof(unsigned char))) == NULL)
+			{
+				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
+				return(NULL);
+			}
+
 			strcpy(chaine, (unsigned char *) ((*s_objet).objet));
 		}
 	}
@@ -1873,7 +1815,7 @@ formateur(struct_processus *s_etat_proce
 
 		while(l_element_courant != NULL)
 		{
-			if ((chaine_formatee = formateur(s_etat_processus, 0,
+			if ((chaine_formatee = formateur(s_etat_processus, offset_initial,
 				   	(*l_element_courant).donnee)) == NULL)
 			{
 				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
@@ -3051,8 +2993,9 @@ formateur(struct_processus *s_etat_proce
 	}
 	else if ((*s_objet).type == MTX)
 	{
-		if (alsprintf(&chaine, "Mutex $ %016lX", (unsigned long)
-				&((*((struct_mutex *) (*s_objet).objet)).mutex)) < 0)
+		if (alsprintf(&chaine, "Mutex $ %016lX owned by $ %016lX",
+				(unsigned long) &((*((struct_mutex *) (*s_objet).objet)).mutex),
+				(unsigned long) (*((struct_mutex *) (*s_objet).objet)).tid) < 0)
 		{
 			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 			return(NULL);
@@ -3528,6 +3471,30 @@ formateur_reel(struct_processus *s_etat_
 
 	if (type == 'R')
 	{
+#		ifdef FP_INFINITE
+		int		signe;
+
+		if ((signe = isinf((*((real8 *) valeur_numerique)))) != 0)
+		{
+			if (signe > 0)
+			{
+				strcpy(chaine, "infinity");
+			}
+			else
+			{
+				strcpy(chaine, "-infinity");
+			}
+
+			return(chaine);
+		}
+#		endif
+
+		if (isnan((*((real8 *) valeur_numerique))))
+		{
+			strcpy(chaine, "undef");
+			return(chaine);
+		}
+
 		tampon_reel = *((real8 *) valeur_numerique);
 
 		if (tampon_reel > ((real8) 0))
@@ -3555,7 +3522,15 @@ formateur_reel(struct_processus *s_etat_
 		}
 		else if (tampon_entier < ((integer8) 0))
 		{
-			exposant = (long) floor(log10(-tampon_entier));
+			if (tampon_entier != INT64_MIN)
+			{
+				exposant = (long) floor(log10(-tampon_entier));
+			}
+			else
+			{
+				tampon_reel = (real8) tampon_entier;
+				exposant = (long) floor(log10(-tampon_reel));
+			}
 		}
 		else
 		{
@@ -3758,8 +3733,15 @@ formateur_reel(struct_processus *s_etat_
 
 			if (exposant >= 0)
 			{
-				sprintf(format, "%%.%luf", (longueur_utile_limite - exposant
-						- 1));
+				if ((exposant + 1) < longueur_utile_limite)
+				{
+					sprintf(format, "%%.%luf", (longueur_utile_limite - exposant
+							- 1));
+				}
+				else
+				{
+					strcpy(format, "%.0f.");
+				}
 			}
 			else
 			{