--- rpl/src/formateur.c	2013/04/01 15:29:34	1.62
+++ rpl/src/formateur.c	2018/12/21 13:36:37	1.91
@@ -1,7 +1,7 @@
 /*
 ================================================================================
-  RPL/2 (R) version 4.1.14
-  Copyright (C) 1989-2013 Dr. BERTRAND Joël
+  RPL/2 (R) version 4.1.29
+  Copyright (C) 1989-2018 Dr. BERTRAND Joël
 
   This file is part of RPL/2.
 
@@ -42,6 +42,8 @@ formateur(struct_processus *s_etat_proce
 	int							parentheses_groupe_gauche;
 	int							parentheses_groupe_droit;
 
+	integer8					(*__type_disp)(struct_processus *, void **);
+
 	logical1					registre45;
 
 	logical4					autorisation_parenthese;
@@ -103,7 +105,8 @@ formateur(struct_processus *s_etat_proce
 --------------------------------------------------------------------------------
 */
 
-		if (alsprintf(&chaine, "@ %016llX", (*((integer8 *)
+		if (alsprintf(s_etat_processus, &chaine,
+				"@ %016llX", (*((unsigned long long *)
 				((*s_objet).objet)))) < 0)
 		{
 			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
@@ -119,14 +122,20 @@ formateur(struct_processus *s_etat_proce
 --------------------------------------------------------------------------------
 */
 
-		if (alsprintf(&chaine, "Library $ %016llX [%s]",
-				(*((struct_bibliotheque *)
+#		pragma GCC diagnostic push
+#		pragma GCC diagnostic ignored "-Wpointer-to-int-cast"
+
+		if (alsprintf(s_etat_processus, &chaine, "Library $ %016llX [%s]",
+				(unsigned long long) (*((struct_bibliotheque *)
 				(*s_objet).objet)).descripteur, (*((struct_bibliotheque *)
 				(*s_objet).objet)).nom) < 0)
 		{
 			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 			return(NULL);
 		}
+
+#		pragma GCC diagnostic pop
+
 	}
 	else if ((*s_objet).type == SPH)
 	{
@@ -137,13 +146,20 @@ formateur(struct_processus *s_etat_proce
 --------------------------------------------------------------------------------
 */
 
-		if (alsprintf(&chaine, "Semaphore $ %016llX '%s'",
+#		pragma GCC diagnostic push
+#		pragma GCC diagnostic ignored "-Wpointer-to-int-cast"
+
+		if (alsprintf(s_etat_processus,
+				&chaine, "Semaphore $ %016llX '%s'", (unsigned long long)
 				&((*((struct_semaphore *) (*s_objet).objet)).semaphore),
 				(*((struct_semaphore *) (*s_objet).objet)).nom) < 0)
 		{
 			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 			return(NULL);
 		}
+
+#		pragma GCC diagnostic pop
+
 	}
 	else if ((*s_objet).type == SQL)
 	{
@@ -158,8 +174,8 @@ formateur(struct_processus *s_etat_proce
 				"MYSQL") == 0)
 		{
 #			ifdef MYSQL_SUPPORT
-			if (alsprintf(&chaine, "Sql $ %016llX (%s)",
-					(logical8) (*((struct_connecteur_sql *)
+			if (alsprintf(s_etat_processus, &chaine, "Sql $ %016llX (%s)",
+					(unsigned long long) (*((struct_connecteur_sql *)
 					(*s_objet).objet)).descripteur.mysql,
 					(*((struct_connecteur_sql *) (*s_objet).objet)).type) < 0)
 			{
@@ -185,8 +201,8 @@ formateur(struct_processus *s_etat_proce
 				"POSTGRESQL") == 0)
 		{
 #			ifdef POSTGRESQL_SUPPORT
-			if (alsprintf(&chaine, "Sql $ %016llX (%s)",
-					(logical8) (*((struct_connecteur_sql *)
+			if (alsprintf(s_etat_processus, &chaine, "Sql $ %016llX (%s)",
+					(unsigned long long) (*((struct_connecteur_sql *)
 					(*s_objet).objet)).descripteur.postgresql,
 					(*((struct_connecteur_sql *) (*s_objet).objet)).type) < 0)
 			{
@@ -227,7 +243,8 @@ formateur(struct_processus *s_etat_proce
 		if ((*(*((struct_processus_fils *) (*s_objet).objet)).thread)
 				.processus_detache == d_vrai)
 		{
-			if (alsprintf(&chaine, "Process $ %016llX", (integer8)
+			if (alsprintf(s_etat_processus, &chaine,
+					"Process $ %016llX", (unsigned long long)
 					(*(*((struct_processus_fils *) (*s_objet).objet)).thread)
 					.pid) < 0)
 			{
@@ -237,10 +254,11 @@ formateur(struct_processus *s_etat_proce
 		}
 		else
 		{
-			if (alsprintf(&chaine, "Light weight process $ %016llX/%016llX",
-					(integer8) (*(*((struct_processus_fils *)
+			if (alsprintf(s_etat_processus, &chaine,
+					"Light weight process $ %016llX/%016llX",
+					(unsigned long long) (*(*((struct_processus_fils *)
 					(*s_objet).objet)).thread).pid,
-					(integer8) (*(*((struct_processus_fils *)
+					(unsigned long long) (*(*((struct_processus_fils *)
 					(*s_objet).objet)).thread).tid) < 0)
 			{
 				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
@@ -257,7 +275,8 @@ formateur(struct_processus *s_etat_proce
 --------------------------------------------------------------------------------
 */
 
-		if (alsprintf(&chaine, "File $ %016llX", (logical8)
+		if (alsprintf(s_etat_processus,
+				&chaine, "File $ %016llX", (unsigned long long)
 				(*((struct_fichier *) ((*s_objet).objet))).descripteur) < 0)
 		{
 			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
@@ -282,8 +301,10 @@ formateur(struct_processus *s_etat_proce
 			cf(s_etat_processus, 45);
 		}
 
-		if ((format_majuscule = conversion_majuscule(format)) == NULL)
+		if ((format_majuscule = conversion_majuscule(s_etat_processus,
+				format)) == NULL)
 		{
+			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 			return(NULL);
 		}
 
@@ -389,7 +410,8 @@ formateur(struct_processus *s_etat_proce
 --------------------------------------------------------------------------------
 */
 
-		if (alsprintf(&chaine, "Socket $ %016llX", (integer8)
+		if (alsprintf(s_etat_processus, &chaine,
+				"Socket $ %016llX", (unsigned long long)
 				(*((struct_socket *) ((*s_objet).objet))).socket) < 0)
 		{
 			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
@@ -414,7 +436,8 @@ formateur(struct_processus *s_etat_proce
 			cf(s_etat_processus, 45);
 		}
 
-		if ((format_majuscule = conversion_majuscule(format)) == NULL)
+		if ((format_majuscule = conversion_majuscule(s_etat_processus,
+				format)) == NULL)
 		{
 			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 			return(NULL);
@@ -687,6 +710,7 @@ formateur(struct_processus *s_etat_proce
 								|| ((*s_etat_processus).instruction_courante[1]
 								== '-')) ? d_vrai : d_faux;
 
+						(*s_etat_processus).type_en_cours = NON;
 						recherche_type(s_etat_processus);
 
 						if ((*s_etat_processus).erreur_execution != d_ex)
@@ -744,6 +768,7 @@ formateur(struct_processus *s_etat_proce
 							{
 								if ((strcmp(chaine_fonction, "AND") == 0) ||
 										(strcmp(chaine_fonction, "XOR") == 0) ||
+										(strcmp(chaine_fonction, "EQV") == 0) ||
 										(strcmp(chaine_fonction, "OR") == 0))
 								{
 									autorisation_parenthese = d_vrai;
@@ -770,6 +795,7 @@ formateur(struct_processus *s_etat_proce
 										(strcmp(chaine_fonction, "-") == 0) ||
 										(strcmp(chaine_fonction, "AND") == 0) ||
 										(strcmp(chaine_fonction, "XOR") == 0) ||
+										(strcmp(chaine_fonction, "EQV") == 0) ||
 										(strcmp(chaine_fonction, "OR") == 0))
 								{
 									autorisation_parenthese = d_vrai;
@@ -850,6 +876,7 @@ formateur(struct_processus *s_etat_proce
 								"'%s'", (unsigned char *)
 								(*s_sous_objet_1).objet);
 
+						(*s_etat_processus).type_en_cours = NON;
 						recherche_type(s_etat_processus);
 
 						if ((*s_etat_processus).erreur_execution != d_ex)
@@ -905,6 +932,7 @@ formateur(struct_processus *s_etat_proce
 							{
 								if ((strcmp(chaine_fonction, "AND") == 0) ||
 										(strcmp(chaine_fonction, "XOR") == 0) ||
+										(strcmp(chaine_fonction, "EQV") == 0) ||
 										(strcmp(chaine_fonction, "OR") == 0))
 								{
 									autorisation_parenthese = d_vrai;
@@ -921,6 +949,7 @@ formateur(struct_processus *s_etat_proce
 										(strcmp(chaine_fonction, "-") == 0) ||
 										(strcmp(chaine_fonction, "AND") == 0) ||
 										(strcmp(chaine_fonction, "XOR") == 0) ||
+										(strcmp(chaine_fonction, "EQV") == 0) ||
 										(strcmp(chaine_fonction, "OR") == 0))
 								{
 									autorisation_parenthese = d_vrai;
@@ -1147,6 +1176,8 @@ formateur(struct_processus *s_etat_proce
 							(*(*l_element_courant).donnee).objet)).nom_fonction,
 							"XOR") == 0) || (strcmp((*((struct_fonction *)
 							(*(*l_element_courant).donnee).objet)).nom_fonction,
+							"EQV") == 0) || (strcmp((*((struct_fonction *)
+							(*(*l_element_courant).donnee).objet)).nom_fonction,
 							"AND") == 0))
 					{
 						if (depilement(s_etat_processus, &((*s_etat_processus)
@@ -1191,6 +1222,7 @@ formateur(struct_processus *s_etat_proce
 								"'%s'", (unsigned char *)
 								(*s_sous_objet_1).objet);
 
+						(*s_etat_processus).type_en_cours = NON;
 						recherche_type(s_etat_processus);
 
 						if ((*s_etat_processus).erreur_execution != d_ex)
@@ -1236,6 +1268,7 @@ formateur(struct_processus *s_etat_proce
 							}
 
 							if (((strcmp(chaine_fonction, "OR") == 0) ||
+									(strcmp(chaine_fonction, "EQV") == 0) ||
 									(strcmp(chaine_fonction, "XOR") == 0)) &&
 									(strcmp((*((struct_fonction *)
 									(*(*l_element_courant).donnee).objet))
@@ -1266,6 +1299,7 @@ formateur(struct_processus *s_etat_proce
 								"'%s'", (unsigned char *)
 								(*s_sous_objet_2).objet);
 
+						(*s_etat_processus).type_en_cours = NON;
 						recherche_type(s_etat_processus);
 
 						if ((*s_etat_processus).erreur_execution != d_ex)
@@ -1311,6 +1345,7 @@ formateur(struct_processus *s_etat_proce
 							}
 
 							if (((strcmp(chaine_fonction, "OR") == 0) ||
+									(strcmp(chaine_fonction, "EQV") == 0) ||
 									(strcmp(chaine_fonction, "XOR") == 0)) &&
 									(strcmp((*((struct_fonction *)
 									(*(*l_element_courant).donnee).objet))
@@ -1586,7 +1621,7 @@ formateur(struct_processus *s_etat_proce
 -- Base décimale ---------------------------------------------------------------
 */
 
-			sprintf(tampon, "%llu", (*((logical8 *)
+			sprintf(tampon, "%llu", (*((unsigned long long *)
 					((*s_objet).objet))) & masque_binaire);
 			strcpy(base, "d");
 		}
@@ -1598,7 +1633,7 @@ formateur(struct_processus *s_etat_proce
 -- Base octale -----------------------------------------------------------------
 */
 
-			sprintf(tampon, "%llo", (*((logical8 *)
+			sprintf(tampon, "%llo", (*((unsigned long long *)
 					((*s_objet).objet))) & masque_binaire);
 			strcpy(base, "o");
 		}
@@ -1609,7 +1644,7 @@ formateur(struct_processus *s_etat_proce
 -- Bases hexadécimale et binaire -----------------------------------------------
 */
 
-			sprintf(tampon, "%llX", (*((logical8 *)
+			sprintf(tampon, "%llX", (*((unsigned long long *)
 					((*s_objet).objet))) & masque_binaire);
 
 			if (test_cfsf(s_etat_processus, 43) == d_vrai)
@@ -2997,7 +3032,8 @@ formateur(struct_processus *s_etat_proce
 	}
 	else if ((*s_objet).type == MTX)
 	{
-		if (alsprintf(&chaine, "Mutex $ %016llX owned by $ %016llX",
+		if (alsprintf(s_etat_processus, &chaine,
+				"Mutex $ %016llX owned by $ %016llX",
 				&((*((struct_mutex *) (*s_objet).objet)).mutex),
 				(logical8) (*((struct_mutex *) (*s_objet).objet)).tid) < 0)
 		{
@@ -3262,6 +3298,60 @@ formateur(struct_processus *s_etat_proce
 
 			if (chaine == NULL)
 			{
+				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
+				return(NULL);
+			}
+
+			strcpy(chaine, chaine_sauvegarde);
+			free(chaine_sauvegarde);
+			strcat(chaine, " ]");
+		}
+	}
+	else if ((*s_objet).type == REC)
+	{
+		chaine = (unsigned char *) malloc(4 * sizeof(unsigned char));
+
+		if (chaine == NULL)
+		{
+			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
+			return(NULL);
+		}
+
+		strcpy(chaine, "|[ ");
+		offset = ((integer8) strlen(chaine)) + offset_initial;
+
+		// L'objet se compose de deux tables à une dimension de
+		// mêmes tailles.
+
+		chaine_sauvegarde = chaine;
+
+		if ((chaine_formatee = formateur(s_etat_processus, (long) offset,
+				(*((struct_record *) (*s_objet).objet)).noms)) == NULL)
+		{
+			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
+			return(NULL);
+		}
+
+		if ((chaine = (unsigned char *) malloc((strlen(chaine_formatee)
+				+ strlen(chaine_sauvegarde) + 1)
+				* sizeof(unsigned char))) == NULL)
+		{
+			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
+			return(NULL);
+		}
+
+		sprintf(chaine, "%s%s", chaine_sauvegarde, chaine_formatee);
+		free(chaine_sauvegarde);
+		free(chaine_formatee);
+
+		if (test_cfsf(s_etat_processus, 45) == d_vrai)
+		{
+			chaine_sauvegarde = chaine;
+
+			if ((chaine = (unsigned char *) malloc(
+					(strlen(chaine_sauvegarde) + 2) * sizeof(unsigned char)))
+					== NULL)
+			{
 				(*s_etat_processus).erreur_systeme =
 						d_es_allocation_memoire;
 				return(NULL);
@@ -3269,8 +3359,153 @@ formateur(struct_processus *s_etat_proce
 
 			strcpy(chaine, chaine_sauvegarde);
 			free(chaine_sauvegarde);
-			strcat(chaine, " ]");
+			strcat(chaine, "\n");
+
+			chaine_sauvegarde = chaine;
+
+			chaine = (unsigned char *) malloc(
+					(strlen(chaine_sauvegarde) + 1 + ((size_t) offset))
+					* sizeof(unsigned char));
+
+			if (chaine == NULL)
+			{
+				(*s_etat_processus).erreur_systeme =
+						d_es_allocation_memoire;
+				return(NULL);
+			}
+
+			strcpy(chaine, chaine_sauvegarde);
+			free(chaine_sauvegarde);
+			ptre = &(chaine[strlen(chaine)]);
+
+			for(k = 0; k < offset; k++, *(ptre++) = ' ');
+
+			(*ptre) = d_code_fin_chaine;
 		}
+		else
+		{
+			chaine_sauvegarde = chaine;
+
+			if ((chaine = (unsigned char *) malloc(
+					(strlen(chaine_sauvegarde) + 2)
+					* sizeof(unsigned char))) == NULL)
+			{
+				(*s_etat_processus).erreur_systeme =
+						d_es_allocation_memoire;
+				return(NULL);
+			}
+
+			strcpy(chaine, chaine_sauvegarde);
+			free(chaine_sauvegarde);
+			strcat(chaine, " ");
+		}
+
+		chaine_sauvegarde = chaine;
+
+		if ((chaine_formatee = formateur(s_etat_processus, (long) offset,
+				(*((struct_record *) (*s_objet).objet)).donnees)) == NULL)
+		{
+			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
+			return(NULL);
+		}
+
+		if ((chaine = (unsigned char *) malloc((strlen(chaine_formatee)
+				+ strlen(chaine_sauvegarde) + 1)
+				* sizeof(unsigned char))) == NULL)
+		{
+			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
+			return(NULL);
+		}
+
+		sprintf(chaine, "%s%s", chaine_sauvegarde, chaine_formatee);
+		free(chaine_sauvegarde);
+		free(chaine_formatee);
+
+		chaine_sauvegarde = chaine;
+		chaine = (unsigned char *) malloc((strlen(chaine_sauvegarde) + 4)
+				* sizeof(unsigned char));
+
+		if (chaine == NULL)
+		{
+			(*s_etat_processus).erreur_systeme =
+					d_es_allocation_memoire;
+			return(NULL);
+		}
+
+		strcpy(chaine, chaine_sauvegarde);
+		free(chaine_sauvegarde);
+		strcat(chaine, " ]|");
+	}
+	else if ((*s_objet).type == NON)
+	{
+		if ((chaine = malloc((strlen("System object") + 1)
+				* sizeof(unsigned char))) == NULL)
+		{
+			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
+			return(NULL);
+		}
+
+		strcpy(chaine, "System object");
+	}
+	else if ((*s_objet).type == EXT)
+	{
+		l_element_courant = (*s_etat_processus).s_bibliotheques;
+
+		while(l_element_courant != NULL)
+		{
+			if ((*((struct_bibliotheque *) (*l_element_courant).donnee))
+					.descripteur == (*s_objet).descripteur_bibliotheque)
+			{
+				if ((__type_disp = dlsym((*s_objet).descripteur_bibliotheque,
+						"__type_disp")) == NULL)
+				{
+					// Symbole externe non affichable
+
+					if ((chaine = malloc((strlen(
+							"External symbol (disp function not found)") + 1)
+							* sizeof(unsigned char))) == NULL)
+					{
+						(*s_etat_processus).erreur_systeme =
+								d_es_allocation_memoire;
+						return(NULL);
+					}
+
+					strcpy(chaine, "External symbol (disp function not found)");
+				}
+				else
+				{
+					// Symbole externe affichable
+					void		**arg;
+
+					arg = (void **) &s_objet;
+					__type_disp(s_etat_processus, arg);
+					chaine = (unsigned char *) (*arg);
+				}
+
+				break;
+			}
+
+			l_element_courant = (*l_element_courant).suivant;
+		}
+
+		if (l_element_courant == NULL)
+		{
+			// Symbole externe non affichable
+
+			if ((chaine = malloc((strlen("External symbol") + 1)
+					* sizeof(unsigned char))) == NULL)
+			{
+				(*s_etat_processus).erreur_systeme =
+						d_es_allocation_memoire;
+				return(NULL);
+			}
+
+			strcpy(chaine, "External symbol");
+		}
+	}
+	else
+	{
+		BUG(1, uprintf("Unknown symbol type\n"));
 	}
 
 	return(chaine);