--- rpl/src/instructions_d4.c	2010/03/04 10:17:50	1.4
+++ rpl/src/instructions_d4.c	2012/12/13 16:59:41	1.42
@@ -1,7 +1,7 @@
 /*
 ================================================================================
-  RPL/2 (R) version 4.0.12
-  Copyright (C) 1989-2010 Dr. BERTRAND Joël
+  RPL/2 (R) version 4.1.11
+  Copyright (C) 1989-2012 Dr. BERTRAND Joël
 
   This file is part of RPL/2.
 
@@ -20,7 +20,7 @@
 */
 
 
-#include "rpl.conv.h"
+#include "rpl-conv.h"
 
 
 /*
@@ -38,18 +38,31 @@
 void
 instruction_delete(struct_processus *s_etat_processus)
 {
+	const char					*queue;
+
 	file						*fichier;
 
+	integer8					lecture_i64;
+
 	logical1					erreur;
 	logical1					existence;
 	logical1					ouverture;
 
+	sqlite3_stmt				*ppStmt;
+
+	struct_descripteur_fichier	*descripteur;
+
 	struct_objet				*s_objet_argument;
+	struct_objet				*s_objet_indice;
 
 	struct flock				lock;
 
 	struct stat					requete;
 
+	unsigned char				*commande;
+	unsigned char				*nom;
+	unsigned char				*utf8;
+
 	unsigned long				unite;
 
 	(*s_etat_processus).erreur_execution = d_ex;
@@ -60,15 +73,17 @@ instruction_delete(struct_processus *s_e
 
 		if ((*s_etat_processus).langue == 'F')
 		{
-			printf("(effacement d'un fichier)\n\n");
+			printf("(effacement d'un fichier ou d'un enregistrement)\n\n");
 		}
 		else
 		{
-			printf("(delete a file)\n\n");
+			printf("(delete file or record)\n\n");
 		}
 
-		printf("    1: %s\n", d_CHN);
+		printf("    1: %s\n\n", d_CHN);
 
+		printf("    2: %s, %s\n", d_CHN, d_INT);
+		printf("    1: %s\n", d_FCH);
 		return;
 	}
 	else if ((*s_etat_processus).test_instruction == 'Y')
@@ -79,10 +94,26 @@ instruction_delete(struct_processus *s_e
 
 	if (test_cfsf(s_etat_processus, 31) == d_vrai)
 	{
-		if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
+		if ((*s_etat_processus).l_base_pile == NULL)
 		{
+			(*s_etat_processus).erreur_execution = d_ex_manque_argument;
 			return;
 		}
+
+		if ((*(*(*s_etat_processus).l_base_pile).donnee).type == FCH)
+		{
+			if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
+			{
+				return;
+			}
+		}
+		else
+		{
+			if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
+			{
+				return;
+			}
+		}
 	}
 
 	if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
@@ -94,10 +125,18 @@ instruction_delete(struct_processus *s_e
 
 	if ((*s_objet_argument).type == CHN)
 	{
-		if (stat((unsigned char *) (*s_objet_argument).objet,
-				&requete) != 0)
+		if ((nom = transliteration(s_etat_processus,
+				(unsigned char *) (*s_objet_argument).objet,
+				d_locale, "UTF-8")) == NULL)
+		{
+			liberation(s_etat_processus, s_objet_argument);
+			return;
+		}
+
+		if (stat(nom, &requete) != 0)
 		{
 			liberation(s_etat_processus, s_objet_argument);
+			free(nom);
 
 			(*s_etat_processus).erreur_execution =
 					d_ex_erreur_acces_fichier;
@@ -106,10 +145,10 @@ instruction_delete(struct_processus *s_e
 
 		if (S_ISREG(requete.st_mode)) // Fichier régulier
 		{
-			if ((fichier = fopen((unsigned char *)
-					(*s_objet_argument).objet, "r+")) == NULL)
+			if ((fichier = fopen(nom, "r+")) == NULL)
 			{
 				liberation(s_etat_processus, s_objet_argument);
+				free(nom);
 
 				(*s_etat_processus).erreur_execution =
 						d_ex_erreur_acces_fichier;
@@ -124,6 +163,8 @@ instruction_delete(struct_processus *s_e
 
 			if (fcntl(fileno(fichier), F_GETLK, &lock) == -1)
 			{
+				free(nom);
+
 				if (fclose(fichier) != 0)
 				{
 					liberation(s_etat_processus, s_objet_argument);
@@ -143,29 +184,30 @@ instruction_delete(struct_processus *s_e
 			if (lock.l_type != F_UNLCK)
 			{
 				liberation(s_etat_processus, s_objet_argument);
+				free(nom);
 
 				(*s_etat_processus).erreur_execution =
 						d_ex_erreur_acces_fichier;
 				return;
 			}
 
-			erreur = caracteristiques_fichier(s_etat_processus,
-					(unsigned char *) (*s_objet_argument).objet,
+			erreur = caracteristiques_fichier(s_etat_processus, nom,
 					&existence, &ouverture, &unite);
 
 			if ((erreur != d_absence_erreur) || (ouverture == d_vrai))
 			{
 				liberation(s_etat_processus, s_objet_argument);
+				free(nom);
 
 				(*s_etat_processus).erreur_execution =
 						d_ex_erreur_acces_fichier;
 				return;
 			}
 
-			if (destruction_fichier((unsigned char *)
-					(*s_objet_argument).objet) == d_erreur)
+			if (destruction_fichier(nom) == d_erreur)
 			{
 				liberation(s_etat_processus, s_objet_argument);
+				free(nom);
 
 				(*s_etat_processus).erreur_execution =
 						d_ex_erreur_acces_fichier;
@@ -174,15 +216,353 @@ instruction_delete(struct_processus *s_e
 		}
 		else // Socket
 		{
-			if (unlink((unsigned char *) (*s_objet_argument).objet) != 0)
+			if (unlink(nom) != 0)
 			{
 				liberation(s_etat_processus, s_objet_argument);
+				free(nom);
 
 				(*s_etat_processus).erreur_execution =
 						d_ex_erreur_acces_fichier;
 				return;
 			}
 		}
+
+		free(nom);
+	}
+	else if ((*s_objet_argument).type == FCH)
+	{
+		if ((descripteur = descripteur_fichier(s_etat_processus,
+				(struct_fichier *) (*s_objet_argument).objet)) == NULL)
+		{
+			return;
+		}
+
+		/*
+		 * Vérification des verrous
+		 */
+
+		lock.l_type = F_RDLCK;
+		lock.l_whence = SEEK_SET;
+		lock.l_start = 0;
+		lock.l_len = 0;
+		lock.l_pid = getpid();
+
+		if (fcntl(fileno((*descripteur).descripteur_c), F_GETLK, &lock)
+				== -1)
+		{
+			liberation(s_etat_processus, s_objet_argument);
+
+			(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+			return;
+		}
+
+		if (lock.l_type != F_UNLCK)
+		{
+			liberation(s_etat_processus, s_objet_argument);
+
+			(*s_etat_processus).erreur_execution =
+					d_ex_fichier_verrouille;
+			return;
+		}
+
+		if ((*((struct_fichier *) (*s_objet_argument).objet))
+				.protection == 'R')
+		{
+			liberation(s_etat_processus, s_objet_argument);
+
+			(*s_etat_processus).erreur_execution = d_ex_erreur_acces_fichier;
+			return;
+		}
+
+		if ((*((struct_fichier *) (*s_objet_argument).objet)).binaire == 'N')
+		{
+			if ((*((struct_fichier *) (*s_objet_argument).objet)).acces
+					== 'S')
+			{
+				liberation(s_etat_processus, s_objet_argument);
+
+				(*s_etat_processus).erreur_execution = d_ex_erreur_type_fichier;
+				return;
+			}
+			else if ((*((struct_fichier *) (*s_objet_argument).objet)).acces
+					== 'D')
+			{
+				BUG(((*descripteur).type == 'C'), uprintf("Bad filtype !\n"));
+
+				if (depilement(s_etat_processus, &((*s_etat_processus)
+						.l_base_pile), &s_objet_indice) == d_erreur)
+				{
+					(*s_etat_processus).erreur_execution = d_ex_manque_argument;
+					return;
+				}
+
+				if ((*s_objet_indice).type != INT)
+				{
+					liberation(s_etat_processus, s_objet_argument);
+					liberation(s_etat_processus, s_objet_indice);
+
+					(*s_etat_processus).erreur_execution =
+							d_ex_erreur_type_argument;
+					return;
+				}
+
+				if (alsprintf(&commande, "select count(*) from data where "
+						"id = %lld", (*((integer8 *) (*s_objet_indice).objet)))
+						< 0)
+				{
+					(*s_etat_processus).erreur_systeme =
+							d_es_allocation_memoire;
+					return;
+				}
+
+				if (sqlite3_prepare_v2((*descripteur).descripteur_sqlite,
+						commande, strlen(commande), &ppStmt, &queue)
+						!= SQLITE_OK)
+				{
+					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+					return;
+				}
+
+				if (sqlite3_step(ppStmt) != SQLITE_ROW)
+				{
+					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+					return;
+				}
+
+				lecture_i64 = sqlite3_column_int64(ppStmt, 0);
+
+				if (sqlite3_step(ppStmt) != SQLITE_DONE)
+				{
+					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+					return;
+				}
+
+				if (sqlite3_finalize(ppStmt) != SQLITE_OK)
+				{
+					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+					return;
+				}
+
+				free(commande);
+
+				if (lecture_i64 == 0)
+				{
+					liberation(s_etat_processus, s_objet_argument);
+					liberation(s_etat_processus, s_objet_indice);
+
+					(*s_etat_processus).erreur_execution =
+							d_ex_enregistrement_inexistant;
+					return;
+				}
+
+				if (alsprintf(&commande, "delete from data where id = %lld",
+						(*((integer8 *) (*s_objet_indice).objet))) < 0)
+				{
+					(*s_etat_processus).erreur_systeme =
+							d_es_allocation_memoire;
+					return;
+				}
+
+				if (sqlite3_prepare_v2((*descripteur).descripteur_sqlite,
+						commande, strlen(commande), &ppStmt, &queue)
+						!= SQLITE_OK)
+				{
+					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+					return;
+				}
+
+				if (sqlite3_step(ppStmt) != SQLITE_DONE)
+				{
+					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+					return;
+				}
+
+				if (sqlite3_finalize(ppStmt) != SQLITE_OK)
+				{
+					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+					return;
+				}
+
+				free(commande);
+				liberation(s_etat_processus, s_objet_indice);
+			}
+			else
+			{
+				BUG(((*descripteur).type == 'C'), uprintf("Bad filtype !\n"));
+
+				if (depilement(s_etat_processus, &((*s_etat_processus)
+						.l_base_pile), &s_objet_indice) == d_erreur)
+				{
+					(*s_etat_processus).erreur_execution = d_ex_manque_argument;
+					return;
+				}
+
+				if ((*s_objet_indice).type != CHN)
+				{
+					liberation(s_etat_processus, s_objet_argument);
+					liberation(s_etat_processus, s_objet_indice);
+
+					(*s_etat_processus).erreur_execution =
+							d_ex_erreur_type_argument;
+					return;
+				}
+
+				// Récupération de l'identifiant de la clef
+
+				if ((utf8 = transliteration(s_etat_processus,
+						(unsigned char *) (*s_objet_indice).objet, d_locale,
+						"UTF-8")) == NULL)
+				{
+					liberation(s_etat_processus, s_objet_argument);
+					liberation(s_etat_processus, s_objet_indice);
+
+					return;
+				}
+
+				if (alsprintf(&commande, "select id from key where key = "
+						"'{ \"%s\" }'", utf8) < 0)
+				{
+					(*s_etat_processus).erreur_systeme =
+							d_es_allocation_memoire;
+					return;
+				}
+
+				free(utf8);
+
+				if (sqlite3_prepare_v2((*descripteur).descripteur_sqlite,
+						commande, strlen(commande), &ppStmt, &queue)
+						!= SQLITE_OK)
+				{
+					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+					return;
+				}
+
+				switch(sqlite3_step(ppStmt))
+				{
+					case SQLITE_ROW:
+					{
+						// Correspondance
+						break;
+					}
+
+					case SQLITE_DONE:
+					{
+						// Aucune correspondance
+						if (sqlite3_finalize(ppStmt) != SQLITE_OK)
+						{
+							(*s_etat_processus).erreur_systeme =
+									d_es_erreur_fichier;
+							return;
+						}
+
+						free(commande);
+
+						liberation(s_etat_processus, s_objet_argument);
+						liberation(s_etat_processus, s_objet_indice);
+
+						(*s_etat_processus).erreur_execution =
+								d_ex_enregistrement_inexistant;
+						return;
+					}
+
+					default:
+					{
+						(*s_etat_processus).erreur_systeme =
+								d_es_erreur_fichier;
+						return;
+					}
+				}
+
+				if (sqlite3_column_type(ppStmt, 0) != SQLITE_INTEGER)
+				{
+					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+					return;
+				}
+
+				lecture_i64 = sqlite3_column_int64(ppStmt, 0);
+
+				if (sqlite3_step(ppStmt) != SQLITE_DONE)
+				{
+					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+					return;
+				}
+
+				if (sqlite3_finalize(ppStmt) != SQLITE_OK)
+				{
+					(*s_etat_processus).erreur_systeme =
+							d_es_erreur_fichier;
+					return;
+				}
+
+				free(commande);
+
+				if (alsprintf(&commande, "delete from data where key_id = %lld",
+						lecture_i64) < 0)
+				{
+					(*s_etat_processus).erreur_systeme =
+							d_es_allocation_memoire;
+					return;
+				}
+
+				if (sqlite3_prepare_v2((*descripteur).descripteur_sqlite,
+						commande, strlen(commande), &ppStmt, &queue)
+						!= SQLITE_OK)
+				{
+					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+					return;
+				}
+
+				if (sqlite3_step(ppStmt) != SQLITE_DONE)
+				{
+					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+					return;
+				}
+
+				if (sqlite3_finalize(ppStmt) != SQLITE_OK)
+				{
+					(*s_etat_processus).erreur_systeme =
+							d_es_erreur_fichier;
+					return;
+				}
+
+				free(commande);
+
+				if (alsprintf(&commande, "delete from key where id = %lld",
+						lecture_i64) < 0)
+				{
+					(*s_etat_processus).erreur_systeme =
+							d_es_allocation_memoire;
+					return;
+				}
+
+				if (sqlite3_prepare_v2((*descripteur).descripteur_sqlite,
+						commande, strlen(commande), &ppStmt, &queue)
+						!= SQLITE_OK)
+				{
+					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+					return;
+				}
+
+				if (sqlite3_step(ppStmt) != SQLITE_DONE)
+				{
+					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
+					return;
+				}
+
+				if (sqlite3_finalize(ppStmt) != SQLITE_OK)
+				{
+					(*s_etat_processus).erreur_systeme =
+							d_es_erreur_fichier;
+					return;
+				}
+
+				free(commande);
+				liberation(s_etat_processus, s_objet_indice);
+			}
+		}
+		else // Fichiers non formatés
+		{
+		}
 	}
 	else
 	{
@@ -286,11 +666,8 @@ instruction_drws(struct_processus *s_eta
 
 	int							dimensions;
 
-	logical1					presence_variable;
 	logical1					matrice_entiere;
 
-	long						i;
-
 	struct_objet				*s_objet_statistique;
 
 	unsigned char				*nom_fichier;
@@ -337,46 +714,24 @@ instruction_drws(struct_processus *s_eta
 	 * Vérification de la présence de la matrice statistique
 	 */
 
-	if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)
+	if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
 	{
 		/*
 		 * Aucune variable ds_sdat n'existe.
 		 */
 
-		(*s_etat_processus).erreur_execution = d_ex_absence_observations;
-		(*s_etat_processus).erreur_systeme = d_es;
-
-		return;
-	}
-
-	i = (*s_etat_processus).position_variable_courante;
-	presence_variable = d_faux;
-
-	while(i >= 0)
-	{
-		if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
-				ds_sdat) == 0) && ((*s_etat_processus)
-				.s_liste_variables[i].niveau == 1))
+		if ((*s_etat_processus).erreur_execution == d_ex)
 		{
-			presence_variable = d_vrai;
-			break;
+			(*s_etat_processus).erreur_execution = d_ex_absence_observations;
 		}
 
-		i--;
-	}
+		(*s_etat_processus).erreur_systeme = d_es;
 
-	if (presence_variable == d_faux)
-	{
-		(*s_etat_processus).erreur_execution = d_ex_absence_observations;
 		return;
 	}
 
-	if ((s_objet_statistique = (*s_etat_processus).s_liste_variables[i].objet)
-			== NULL)
-	{
-		(*s_etat_processus).erreur_execution = d_ex_variable_partagee;
-		return;
-	}
+	s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
+			.objet;
 
 	if ((*s_objet_statistique).type == MIN)
 	{
@@ -703,8 +1058,7 @@ instruction_decr(struct_processus *s_eta
 
 		liberation(s_etat_processus, s_objet_argument);
 
-		if ((*s_etat_processus).s_liste_variables
-				[(*s_etat_processus).position_variable_courante]
+		if ((*(*s_etat_processus).pointeur_variable_courante)
 				.variable_verrouillee == d_vrai)
 		{
 			(*s_etat_processus).erreur_execution =
@@ -712,25 +1066,14 @@ instruction_decr(struct_processus *s_eta
 			return;
 		}
 
-		if ((*s_etat_processus).s_liste_variables
-				[(*s_etat_processus).position_variable_courante].objet
+		if ((*(*s_etat_processus).pointeur_variable_courante).objet
 				== NULL)
 		{
-			if (pthread_mutex_lock(&((*(*s_etat_processus)
-					.s_liste_variables_partagees).mutex)) != 0)
-			{
-				(*s_etat_processus).erreur_systeme = d_es_processus;
-				return;
-			}
-
 			if (recherche_variable_partagee(s_etat_processus,
-					(*s_etat_processus).s_liste_variables
-					[(*s_etat_processus).position_variable_courante].nom,
-					(*s_etat_processus).s_liste_variables
-					[(*s_etat_processus).position_variable_courante]
-					.variable_partagee, (*s_etat_processus).s_liste_variables
-					[(*s_etat_processus).position_variable_courante]
-					.origine) == d_faux)
+					(*(*s_etat_processus).pointeur_variable_courante).nom,
+					(*(*s_etat_processus).pointeur_variable_courante)
+					.variable_partagee, (*(*s_etat_processus)
+					.pointeur_variable_courante).origine) == d_faux)
 			{
 				(*s_etat_processus).erreur_systeme = d_es;
 				(*s_etat_processus).erreur_execution =
@@ -740,15 +1083,13 @@ instruction_decr(struct_processus *s_eta
 			}
 
 			s_objet_argument = (*(*s_etat_processus)
-					.s_liste_variables_partagees).table
-					[(*(*s_etat_processus).s_liste_variables_partagees)
-					.position_variable].objet;
+					.pointeur_variable_partagee_courante).objet;
 			variable_partagee = d_vrai;
 		}
 		else
 		{
-			s_objet_argument = (*s_etat_processus).s_liste_variables
-					[(*s_etat_processus).position_variable_courante].objet;
+			s_objet_argument = (*(*s_etat_processus).pointeur_variable_courante)
+					.objet;
 			variable_partagee = d_faux;
 		}
 
@@ -758,7 +1099,7 @@ instruction_decr(struct_processus *s_eta
 			if (variable_partagee == d_vrai)
 			{
 				if (pthread_mutex_unlock(&((*(*s_etat_processus)
-						.s_liste_variables_partagees).mutex)) != 0)
+						.pointeur_variable_partagee_courante).mutex)) != 0)
 				{
 					(*s_etat_processus).erreur_systeme = d_es_processus;
 					return;
@@ -773,17 +1114,14 @@ instruction_decr(struct_processus *s_eta
 
 		if (variable_partagee == d_vrai)
 		{
-			(*s_etat_processus).s_liste_variables[(*s_etat_processus)
-					.position_variable_courante].objet = NULL;
-			(*(*s_etat_processus)
-					.s_liste_variables_partagees).table
-					[(*(*s_etat_processus).s_liste_variables_partagees)
-					.position_variable].objet = s_copie_argument;
+			(*(*s_etat_processus).pointeur_variable_courante).objet = NULL;
+			(*(*s_etat_processus).pointeur_variable_partagee_courante).objet =
+					s_copie_argument;
 		}
 		else
 		{
-			(*s_etat_processus).s_liste_variables[(*s_etat_processus)
-					.position_variable_courante].objet = s_copie_argument;
+			(*(*s_etat_processus).pointeur_variable_courante).objet =
+					s_copie_argument;
 		}
 
 		if ((*s_copie_argument).type == INT)
@@ -793,7 +1131,7 @@ instruction_decr(struct_processus *s_eta
 			if (variable_partagee == d_vrai)
 			{
 				if (pthread_mutex_unlock(&((*(*s_etat_processus)
-						.s_liste_variables_partagees).mutex)) != 0)
+						.pointeur_variable_partagee_courante).mutex)) != 0)
 				{
 					(*s_etat_processus).erreur_systeme = d_es_processus;
 					return;
@@ -805,7 +1143,7 @@ instruction_decr(struct_processus *s_eta
 			if (variable_partagee == d_vrai)
 			{
 				if (pthread_mutex_unlock(&((*(*s_etat_processus)
-						.s_liste_variables_partagees).mutex)) != 0)
+						.pointeur_variable_partagee_courante).mutex)) != 0)
 				{
 					(*s_etat_processus).erreur_systeme = d_es_processus;
 					return;