--- rpl/src/types.c 2010/04/20 12:49:18 1.12 +++ rpl/src/types.c 2012/01/17 14:44:13 1.45 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.0.14 - Copyright (C) 1989-2010 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.6 + 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" /* @@ -75,9 +75,11 @@ recherche_type(struct_processus *s_etat_ unsigned char registre_instruction_valide; unsigned char registre_interruption; unsigned char registre_mode_execution_programme; + unsigned char registre_recherche_type; unsigned char registre_test; unsigned char registre_test_bis; unsigned char *tampon; + unsigned char variable_implicite; unsigned long i; unsigned long j; @@ -370,8 +372,13 @@ recherche_type(struct_processus *s_etat_ } } + registre_recherche_type = (*s_etat_processus).recherche_type; + (*s_etat_processus).recherche_type = 'Y'; + if (sequenceur(s_etat_processus) == d_erreur) { + (*s_etat_processus).erreur_execution = d_ex_syntaxe; + (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).instruction_courante = tampon; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; @@ -397,6 +404,7 @@ recherche_type(struct_processus *s_etat_ return; } + (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).instruction_courante = tampon; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; @@ -1162,8 +1170,15 @@ recherche_type(struct_processus *s_etat_ } } + registre_recherche_type = + (*s_etat_processus).recherche_type; + (*s_etat_processus).recherche_type = 'Y'; + if (sequenceur(s_etat_processus) == d_erreur) { + (*s_etat_processus).erreur_execution = d_ex_syntaxe; + (*s_etat_processus).recherche_type = + registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; nombre_lignes_a_supprimer = @@ -1210,6 +1225,8 @@ recherche_type(struct_processus *s_etat_ return; } + (*s_etat_processus).recherche_type = + registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; @@ -1570,9 +1587,16 @@ recherche_type(struct_processus *s_etat_ return; } } + + registre_recherche_type = (*s_etat_processus) + .recherche_type; + (*s_etat_processus).recherche_type = 'Y'; if (sequenceur(s_etat_processus) == d_erreur) { + (*s_etat_processus).erreur_execution = d_ex_syntaxe; + (*s_etat_processus).recherche_type = + registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; nombre_lignes_a_supprimer = @@ -1620,6 +1644,8 @@ recherche_type(struct_processus *s_etat_ return; } + (*s_etat_processus).recherche_type = + registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; @@ -2293,11 +2319,24 @@ recherche_type(struct_processus *s_etat_ } } + variable_implicite = (*s_etat_processus).autorisation_nom_implicite; + registre_recherche_type = (*s_etat_processus).recherche_type; + (*s_etat_processus).recherche_type = 'Y'; + (*s_etat_processus).autorisation_nom_implicite = 'Y'; + if (sequenceur(s_etat_processus) == d_erreur) { + (*s_etat_processus).autorisation_nom_implicite = + variable_implicite; + (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; - (*s_etat_processus).erreur_execution = d_ex_syntaxe; + + if ((*s_etat_processus).erreur_execution != + d_ex_nom_implicite) + { + (*s_etat_processus).erreur_execution = d_ex_syntaxe; + } nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle @@ -2343,6 +2382,8 @@ recherche_type(struct_processus *s_etat_ return; } + (*s_etat_processus).autorisation_nom_implicite = variable_implicite; + (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; @@ -2827,6 +2868,16 @@ recherche_type(struct_processus *s_etat_ (*(--ptr_ecriture)) = d_code_fin_chaine; + if (validation_chaine((unsigned char *) element) == d_faux) + { + (*s_etat_processus).erreur_execution = d_ex_syntaxe; + (*s_etat_processus).traitement_interruptible = + registre_interruption; + + free(element); + return; + } + break; } @@ -2923,8 +2974,20 @@ recherche_type(struct_processus *s_etat_ } } + registre_recherche_type = (*s_etat_processus).recherche_type; + (*s_etat_processus).recherche_type = 'Y'; + + variable_implicite = + (*s_etat_processus).autorisation_nom_implicite; + (*s_etat_processus).autorisation_nom_implicite = 'Y'; + if (sequenceur(s_etat_processus) == d_erreur) { + (*s_etat_processus).autorisation_nom_implicite = + variable_implicite; + (*s_etat_processus).erreur_execution = d_ex_syntaxe; + (*s_etat_processus).recherche_type = + registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; nombre_lignes_a_supprimer = @@ -2972,6 +3035,9 @@ recherche_type(struct_processus *s_etat_ return; } + (*s_etat_processus).autorisation_nom_implicite = + variable_implicite; + (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; @@ -3122,7 +3188,6 @@ recherche_type(struct_processus *s_etat_ if (element == NULL) { -// ICI if ((*s_etat_processus).erreur_systeme != d_es) { (*s_etat_processus).erreur_systeme = @@ -3378,6 +3443,26 @@ recherche_type(struct_processus *s_etat_ if ((drapeau_valeur_reelle == d_faux) && (drapeau_valeur_entiere == d_faux)) { + ptr = (*s_etat_processus).instruction_courante; + + while((*ptr) != d_code_fin_chaine) + { + if ((isalnum((*ptr)) == 0) && + ((*ptr) != '_') && + ((*ptr) != '$')) + { + free(s_objet); + + (*s_etat_processus).erreur_execution = d_ex_syntaxe; + (*s_etat_processus).traitement_interruptible = + registre_interruption; + + return; + } + + ptr++; + } + (*s_objet).type = NOM; element = malloc(sizeof(struct_nom)); @@ -3437,28 +3522,64 @@ recherche_type(struct_processus *s_etat_ } else { - (*s_objet).type = INT; + // Le format ressemble à un entier mais il peut y avoir + // un dépassement de capacité lors de la conversion. + // On convertit donc en entier et en réel. Si les + // deux conversions donnent le même résultat, on + // considère que la conversion en entier est bonne. Dans + // le cas contraire, on garde la conversion en réel. - element = (void *) ((integer8 *) malloc( - sizeof(integer8))); + integer8 conversion_entiere; + real8 conversion_reelle; - if (element == NULL) + if (sscanf((*s_etat_processus).instruction_courante, "%lg", + &conversion_reelle) != 1) { - (*s_etat_processus).erreur_systeme = - d_es_allocation_memoire; - (*s_etat_processus).traitement_interruptible = - registre_interruption; - return; + (*s_etat_processus).erreur_execution = d_ex_syntaxe; } - nombre_elements_convertis = sscanf( - (*s_etat_processus).instruction_courante, "%lld", - (integer8 *) element); - - if (nombre_elements_convertis != 1) + if (sscanf((*s_etat_processus).instruction_courante, "%lld", + &conversion_entiere) != 1) { (*s_etat_processus).erreur_execution = d_ex_syntaxe; } + + if (abs(nextafter(conversion_reelle, conversion_entiere) + - conversion_reelle) >= abs(conversion_reelle + - conversion_entiere)) + { + (*s_objet).type = INT; + + element = malloc(sizeof(integer8)); + + if (element == NULL) + { + (*s_etat_processus).erreur_systeme = + d_es_allocation_memoire; + (*s_etat_processus).traitement_interruptible = + registre_interruption; + return; + } + + (*((integer8 *) element)) = conversion_entiere; + } + else + { + (*s_objet).type = REL; + + element = malloc(sizeof(real8)); + + if (element == NULL) + { + (*s_etat_processus).erreur_systeme = + d_es_allocation_memoire; + (*s_etat_processus).traitement_interruptible = + registre_interruption; + return; + } + + (*((real8 *) element)) = conversion_reelle; + } } }