--- rpl/src/compilation.c	2012/01/25 16:38:30	1.39
+++ rpl/src/compilation.c	2013/03/17 22:26:43	1.56
@@ -1,7 +1,7 @@
 /*
 ================================================================================
-  RPL/2 (R) version 4.1.6
-  Copyright (C) 1989-2012 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.
 
@@ -358,84 +358,84 @@ compilation(struct_processus *s_etat_pro
 ================================================================================
 */
 
-logical1
-analyse_syntaxique(struct_processus *s_etat_processus)
-{
-	enum t_condition	{ AN_IF = 1, AN_IFERR, AN_THEN, AN_ELSE, AN_ELSEIF,
-						AN_END, AN_DO, AN_UNTIL, AN_WHILE, AN_REPEAT, AN_SELECT,
-						AN_CASE, AN_DEFAULT, AN_UP, AN_DOWN, AN_FOR, AN_START,
-						AN_NEXT, AN_STEP };
+enum t_condition	{ AN_IF = 1, AN_IFERR, AN_THEN, AN_ELSE, AN_ELSEIF,
+					AN_END, AN_DO, AN_UNTIL, AN_WHILE, AN_REPEAT, AN_SELECT,
+					AN_CASE, AN_DEFAULT, AN_UP, AN_DOWN, AN_FOR, AN_START,
+					AN_NEXT, AN_STEP, AN_CRITICAL, AN_FORALL };
 
-	unsigned char		*instruction;
-	unsigned char		registre;
+typedef struct pile
+{
+	enum t_condition	condition;
+	struct pile			*suivant;
+} struct_pile_analyse;
+
+static inline struct_pile_analyse *
+empilement_analyse(struct_pile_analyse *ancienne_base,
+		enum t_condition condition)
+{
+	struct_pile_analyse		*nouvelle_base;
 
-	typedef struct pile
+	if ((nouvelle_base = malloc(sizeof(struct_pile_analyse))) == NULL)
 	{
-		enum t_condition	condition;
-		struct pile			*suivant;
-	} struct_pile_analyse;
+		return(NULL);
+	}
 
-	struct_pile_analyse		*l_base_pile;
-	struct_pile_analyse		*l_nouvelle_base_pile;
+	(*nouvelle_base).suivant = ancienne_base;
+	(*nouvelle_base).condition = condition;
 
-	inline struct_pile_analyse *
-	empilement_analyse(struct_pile_analyse *ancienne_base,
-			enum t_condition condition)
-	{
-		struct_pile_analyse		*nouvelle_base;
-
-		if ((nouvelle_base = malloc(sizeof(struct_pile_analyse))) == NULL)
-		{
-			return(NULL);
-		}
-
-		(*nouvelle_base).suivant = ancienne_base;
-		(*nouvelle_base).condition = condition;
+	return(nouvelle_base);
+}
 
-		return(nouvelle_base);
-	}
+static inline struct_pile_analyse *
+depilement_analyse(struct_pile_analyse *ancienne_base)
+{
+	struct_pile_analyse		*nouvelle_base;
 
-	inline struct_pile_analyse *
-	depilement_analyse(struct_pile_analyse *ancienne_base)
+	if (ancienne_base == NULL)
 	{
-		struct_pile_analyse		*nouvelle_base;
+		return(NULL);
+	}
 
-		if (ancienne_base == NULL)
-		{
-			return(NULL);
-		}
+	nouvelle_base = (*ancienne_base).suivant;
+	free(ancienne_base);
 
-		nouvelle_base = (*ancienne_base).suivant;
-		free(ancienne_base);
+	return(nouvelle_base);
+}
 
-		return(nouvelle_base);
+static inline logical1
+test_analyse(struct_pile_analyse *l_base_pile, enum t_condition condition)
+{
+	if (l_base_pile == NULL)
+	{
+		return(d_faux);
 	}
 
-	inline logical1
-	test_analyse(struct_pile_analyse *l_base_pile, enum t_condition condition)
-	{
-		if (l_base_pile == NULL)
-		{
-			return(d_faux);
-		}
+	return(((*l_base_pile).condition == condition) ? d_vrai : d_faux);
+}
 
-		return(((*l_base_pile).condition == condition) ? d_vrai : d_faux);
-	}
+static inline void
+liberation_analyse(struct_pile_analyse *l_base_pile)
+{
+	struct_pile_analyse		*l_nouvelle_base_pile;
 
-	inline void
-	liberation_analyse(struct_pile_analyse *l_base_pile)
+	while(l_base_pile != NULL)
 	{
-		struct_pile_analyse		*l_nouvelle_base_pile;
+		l_nouvelle_base_pile = (*l_base_pile).suivant;
+		free(l_base_pile);
+		l_base_pile = l_nouvelle_base_pile;
+	}
 
-		while(l_base_pile != NULL)
-		{
-			l_nouvelle_base_pile = (*l_base_pile).suivant;
-			free(l_base_pile);
-			l_base_pile = l_nouvelle_base_pile;
-		}
+	return;
+}
 
-		return;
-	}
+logical1
+analyse_syntaxique(struct_processus *s_etat_processus)
+{
+	unsigned char		*instruction;
+	unsigned char		registre;
+
+	struct_pile_analyse		*l_base_pile;
+	struct_pile_analyse		*l_nouvelle_base_pile;
 
 	l_base_pile = NULL;
 	l_nouvelle_base_pile = NULL;
@@ -514,6 +514,19 @@ analyse_syntaxique(struct_processus *s_e
 
 			l_base_pile = l_nouvelle_base_pile;
 		}
+		else if (strcmp(instruction, "CRITICAL") == 0)
+		{
+			if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile,
+					AN_CRITICAL)) == NULL)
+			{
+				liberation_analyse(l_base_pile);
+
+				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
+				return(d_erreur);
+			}
+
+			l_base_pile = l_nouvelle_base_pile;
+		}
 		else if (strcmp(instruction, "THEN") == 0)
 		{
 			if ((test_analyse(l_base_pile, AN_IF) == d_faux) &&
@@ -572,6 +585,7 @@ analyse_syntaxique(struct_processus *s_e
 					(test_analyse(l_base_pile, AN_DEFAULT) == d_faux) &&
 					(test_analyse(l_base_pile, AN_SELECT) == d_faux) &&
 					(test_analyse(l_base_pile, AN_THEN) == d_faux) &&
+					(test_analyse(l_base_pile, AN_CRITICAL) == d_faux) &&
 					(test_analyse(l_base_pile, AN_ELSE) == d_faux))
 			{
 				liberation_analyse(l_base_pile);
@@ -753,9 +767,23 @@ analyse_syntaxique(struct_processus *s_e
 
 			l_base_pile = l_nouvelle_base_pile;
 		}
+		else if (strcmp(instruction, "FORALL") == 0)
+		{
+			if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile,
+					AN_FORALL)) == NULL)
+			{
+				liberation_analyse(l_base_pile);
+
+				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
+				return(d_erreur);
+			}
+
+			l_base_pile = l_nouvelle_base_pile;
+		}
 		else if (strcmp(instruction, "NEXT") == 0)
 		{
 			if ((test_analyse(l_base_pile, AN_FOR) == d_faux) &&
+					(test_analyse(l_base_pile, AN_FORALL) == d_faux) &&
 					(test_analyse(l_base_pile, AN_START) == d_faux))
 			{
 				liberation_analyse(l_base_pile);
@@ -822,42 +850,120 @@ analyse_syntaxique(struct_processus *s_e
 ================================================================================
 */
 
+static char					*ligne = NULL;
+static unsigned int			niveau = 0;
+
 int
 readline_analyse_syntaxique(int count, int key)
 {
-	struct_processus			s_etat_processus;
+	char						prompt[] = "+ %03d> ";
+	char						prompt2[8];
+	char						*registre;
 
-	s_etat_processus.definitions_chainees = rl_line_buffer;
-	s_etat_processus.debug = d_faux;
+	struct_processus			s_etat_processus;
 
 	if ((*rl_line_buffer) == d_code_fin_chaine)
 	{
-		rl_done = 1;
+		if (ligne == NULL)
+		{
+			rl_done = 1;
+		}
+		else
+		{
+			rl_done = 0;
+		}
 	}
 	else
 	{
+		if (ligne == NULL)
+		{
+			if ((ligne = malloc((strlen(rl_line_buffer) + 1)
+					* sizeof(char))) == NULL)
+			{
+				rl_done = 1;
+				return(0);
+			}
+
+			strcpy(ligne, rl_line_buffer);
+		}
+		else
+		{
+			registre = ligne;
+
+			if ((ligne = malloc((strlen(registre)
+					+ strlen(rl_line_buffer) + 2) * sizeof(char))) == NULL)
+			{
+				rl_done = 1;
+				return(0);
+			}
+
+			sprintf(ligne, "%s %s", registre, rl_line_buffer);
+		}
+
+		rl_replace_line("", 1);
+
+		s_etat_processus.definitions_chainees = ligne;
+		s_etat_processus.debug = d_faux;
+		s_etat_processus.erreur_systeme = d_es;
+		s_etat_processus.erreur_execution = d_ex;
+
 		if (analyse_syntaxique(&s_etat_processus) == d_absence_erreur)
 		{
 			rl_done = 1;
 		}
 		else
 		{
-			rl_done = 0;
-			rl_mark = rl_end;
-			rl_crlf();
-			rl_expand_prompt("     > ");
-			rl_on_new_line();
+			if (s_etat_processus.erreur_systeme != d_es)
+			{
+				rl_done = 1;
+			}
+			else
+			{
+				rl_done = 0;
+				rl_crlf();
+
+				sprintf(prompt2, prompt, ++niveau);
+
+				rl_expand_prompt(prompt2);
+				rl_on_new_line();
+			}
 		}
 	}
 
 	if (rl_done != 0)
 	{
 		uprintf("\n");
+
+		if (ligne != NULL)
+		{
+			rl_replace_line(ligne, 1);
+
+			free(ligne);
+			ligne = NULL;
+		}
+
+		niveau = 0;
 	}
 
 	return(0);
 }
 
+int
+readline_effacement(int count, int key)
+{
+	rl_done = 0;
+	rl_replace_line("", 1);
+
+	free(ligne);
+	ligne = NULL;
+	niveau = 0;
+
+	uprintf("^G\n");
+	rl_expand_prompt("RPL/2> ");
+	rl_on_new_line();
+	return(0);
+}
+
 
 /*
 ================================================================================
@@ -974,6 +1080,10 @@ recherche_instruction_suivante(struct_pr
 		{
 			case ']' :
 			case '}' :
+			{
+				break;
+			}
+
 			case ')' :
 			{
 				erreur_format = d_ex_syntaxe;
@@ -1312,100 +1422,109 @@ recherche_instruction_suivante(struct_pr
 				while((niveau != 0) && ((*pointeur_caractere_courant) !=
 						d_code_fin_chaine))
 				{
-					switch(*pointeur_caractere_courant)
+					(*s_etat_processus).position_courante =
+							pointeur_caractere_courant
+							- (*s_etat_processus).definitions_chainees;
+
+					if (recherche_instruction_suivante(s_etat_processus)
+							== d_erreur)
 					{
-						case '{' :
+						if ((*s_etat_processus).instruction_courante
+								!= NULL)
 						{
-							if (niveau_annexe == 0)
-							{
-								niveau++;
-							}
-							else
-							{
-								erreur_analyse = d_ex_syntaxe;
-							}
-
-							break;
+							free((*s_etat_processus).instruction_courante);
 						}
 
-						case '}' :
-						{
-							if (niveau_annexe == 0)
-							{
-								niveau--;
-							}
-							else
-							{
-								erreur_analyse = d_ex_syntaxe;
-							}
+						return(d_erreur);
+					}
 
-							break;
-						}
+					pointeur_caractere_courant =
+							(*s_etat_processus).definitions_chainees +
+							(*s_etat_processus).position_courante;
 
-						case '[' :
+					if (strcmp((*s_etat_processus).instruction_courante, "{")
+							== 0)
+					{
+						if (niveau_annexe == 0)
 						{
-							niveau_annexe++;
-
-							if (niveau_annexe > 2)
-							{
-								erreur_analyse = d_ex_syntaxe;
-							}
-
-							break;
+							niveau++;
 						}
-
-						case ']' :
+						else
 						{
-							niveau_annexe--;
-
-							if (niveau_annexe < 0)
-							{
-								erreur_analyse = d_ex_syntaxe;
-							}
+							erreur_analyse = d_ex_syntaxe;
+						}
+					}
+					else if (strcmp((*s_etat_processus).instruction_courante,
+							"}") == 0)
+					{
+						if (niveau_annexe == 0)
+						{
+							niveau--;
+						}
+						else
+						{
+							erreur_analyse = d_ex_syntaxe;
+						}
+					}
+					else if (strcmp((*s_etat_processus).instruction_courante,
+							"<[") == 0)
+					{
+						niveau++;
+					}
+					else if (strcmp((*s_etat_processus).instruction_courante,
+							"]>") == 0)
+					{
+						niveau--;
+					}
+					else if (strcmp((*s_etat_processus).instruction_courante,
+							"[") == 0)
+					{
+						niveau_annexe++;
 
-							break;
+						if (niveau_annexe > 2)
+						{
+							erreur_analyse = d_ex_syntaxe;
 						}
+					}
+					else if (strcmp((*s_etat_processus).instruction_courante,
+							"[[") == 0)
+					{
+						niveau_annexe += 2;
 
-						case '"' :
+						if (niveau_annexe > 2)
 						{
-							if (niveau_annexe == 0)
-							{
-								pointeur_caractere_courant++;
+							erreur_analyse = d_ex_syntaxe;
+						}
+					}
+					else if (strcmp((*s_etat_processus).instruction_courante,
+							"]") == 0)
+					{
+						niveau_annexe--;
 
-								while((*pointeur_caractere_courant != '"') &&
-										((*pointeur_caractere_courant) !=
-										d_code_fin_chaine))
-								{
-									if (*pointeur_caractere_courant == '\\')
-									{
-										pointeur_caractere_courant++;
-
-										switch(*pointeur_caractere_courant)
-										{
-											case '\\' :
-											case '"' :
-											{
-												pointeur_caractere_courant++;
-												break;
-											}
-										}
-									}
-									else
-									{
-										pointeur_caractere_courant++;
-									}
-								}
-							}
-							else
-							{
-								erreur_analyse = d_ex_syntaxe;
-							}
+						if (niveau_annexe < 0)
+						{
+							erreur_analyse = d_ex_syntaxe;
+						}
+					}
+					else if (strcmp((*s_etat_processus).instruction_courante,
+							"]]") == 0)
+					{
+						niveau_annexe -= 2;
 
-							break;
+						if (niveau_annexe < 0)
+						{
+							erreur_analyse = d_ex_syntaxe;
+						}
+					}
+					else if ((*s_etat_processus).instruction_courante[0] == '"')
+					{
+						if (niveau_annexe != 0)
+						{
+							erreur_analyse = d_ex_syntaxe;
 						}
 					}
 
-					pointeur_caractere_courant++;
+					free((*s_etat_processus).instruction_courante);
 				}
 
 				if ((niveau != 0) || (niveau_annexe != 0))
@@ -1499,7 +1618,7 @@ recherche_instruction_suivante(struct_pr
 			{
 				if (((*s_etat_processus).autorisation_empilement_programme
 						== 'Y') && ((*pointeur_caractere_courant) == '<'))
-				{
+				{ // Cas << >>
 					if (pointeur_debut_instruction !=
 							(pointeur_caractere_courant - 1))
 					{
@@ -1511,48 +1630,38 @@ recherche_instruction_suivante(struct_pr
 					while((niveau != 0) && ((*pointeur_caractere_courant) !=
 							d_code_fin_chaine))
 					{
-						if (((*pointeur_caractere_courant) == '<') &&
-								((*(pointeur_caractere_courant + 1)) == '<'))
+						(*s_etat_processus).position_courante =
+								pointeur_caractere_courant
+								- (*s_etat_processus).definitions_chainees;
+
+						if (recherche_instruction_suivante(s_etat_processus)
+								== d_erreur)
 						{
-							niveau++;
-							pointeur_caractere_courant++;
+							if ((*s_etat_processus).instruction_courante
+									!= NULL)
+							{
+								free((*s_etat_processus).instruction_courante);
+							}
+
+							return(d_erreur);
 						}
-						else if (((*pointeur_caractere_courant) == '>') &&
-								((*(pointeur_caractere_courant + 1)) == '>'))
+
+						pointeur_caractere_courant =
+								(*s_etat_processus).definitions_chainees +
+								(*s_etat_processus).position_courante;
+
+						if (strcmp((*s_etat_processus).instruction_courante,
+								"<<") == 0)
 						{
-							niveau--;
-							pointeur_caractere_courant++;
+							niveau++;
 						}
-						else if ((*pointeur_caractere_courant) == '"')
+						else if (strcmp((*s_etat_processus)
+								.instruction_courante, ">>") == 0)
 						{
-							pointeur_caractere_courant++;
-
-							while((*pointeur_caractere_courant != '"') &&
-									((*pointeur_caractere_courant) !=
-									d_code_fin_chaine))
-							{
-								if (*pointeur_caractere_courant == '\\')
-								{
-									pointeur_caractere_courant++;
-
-									switch(*pointeur_caractere_courant)
-									{
-										case '\\' :
-										case '"' :
-										{
-											pointeur_caractere_courant++;
-											break;
-										}
-									}
-								}
-								else
-								{
-									pointeur_caractere_courant++;
-								}
-							}
+							niveau--;
 						}
 
-						pointeur_caractere_courant++;
+						free((*s_etat_processus).instruction_courante);
 					}
 
 					if (niveau != 0)
@@ -1563,7 +1672,7 @@ recherche_instruction_suivante(struct_pr
 					drapeau_fin_objet = d_vrai;
 				}
 				else if ((*pointeur_caractere_courant) == '[')
-				{
+				{ // Cas <[ ]>
 					if (pointeur_debut_instruction !=
 							(pointeur_caractere_courant - 1))
 					{