--- rpl/src/compilation.c 2013/09/06 10:30:50 1.63 +++ rpl/src/compilation.c 2015/01/05 13:12:29 1.70 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.1.16 - Copyright (C) 1989-2013 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.19 + Copyright (C) 1989-2015 Dr. BERTRAND Joël This file is part of RPL/2. @@ -20,6 +20,7 @@ */ +#define DEBUG_ERREURS #include "rpl-conv.h" @@ -1017,6 +1018,15 @@ swap(void *variable_1, void *variable_2, logical1 recherche_instruction_suivante(struct_processus *s_etat_processus) { + return(recherche_instruction_suivante_recursive(s_etat_processus, 0)); +} + +logical1 +recherche_instruction_suivante_recursive(struct_processus *s_etat_processus, + integer8 recursivite) +{ + enum t_type registre_type_en_cours; + logical1 drapeau_fin_objet; logical1 erreur; @@ -1024,18 +1034,45 @@ recherche_instruction_suivante(struct_pr int erreur_format; unsigned char base_binaire; + unsigned char caractere_fin; unsigned char *pointeur_caractere_courant; unsigned char *pointeur_caractere_destination; unsigned char *pointeur_debut_instruction; unsigned char *pointeur_fin_instruction; signed long niveau; - signed long niveau_annexe; erreur_analyse = d_ex; erreur_format = d_ex; erreur = d_absence_erreur; + switch((*s_etat_processus).type_en_cours) + { + case RPN: + { + caractere_fin = '>'; + break; + } + + case LST: + { + caractere_fin = '}'; + break; + } + + case TBL: + { + caractere_fin = ']'; + break; + } + + default: + { + caractere_fin = d_code_espace; + break; + } + } + drapeau_fin_objet = d_faux; niveau = 0; @@ -1074,8 +1111,7 @@ recherche_instruction_suivante(struct_pr while(((*pointeur_caractere_courant) != d_code_espace) && ((*pointeur_caractere_courant) != d_code_fin_chaine) && (drapeau_fin_objet == d_faux) && - (erreur_analyse == d_ex) && - (erreur_format == d_ex)) + (erreur_analyse == d_ex) && (erreur_format == d_ex)) { switch(*pointeur_caractere_courant++) { @@ -1294,7 +1330,8 @@ recherche_instruction_suivante(struct_pr pointeur_caractere_courant++; if (((*pointeur_caractere_courant) != d_code_fin_chaine) && - ((*pointeur_caractere_courant) != ' ')) + ((*pointeur_caractere_courant) != d_code_espace) && + ((*pointeur_caractere_courant) != caractere_fin)) { erreur_analyse = d_ex_syntaxe; } @@ -1418,7 +1455,6 @@ recherche_instruction_suivante(struct_pr } niveau = 1; - niveau_annexe = 0; while((niveau != 0) && ((*pointeur_caractere_courant) != d_code_fin_chaine)) @@ -1427,108 +1463,40 @@ recherche_instruction_suivante(struct_pr pointeur_caractere_courant - (*s_etat_processus).definitions_chainees; - if (recherche_instruction_suivante(s_etat_processus) - == d_erreur) + registre_type_en_cours = (*s_etat_processus).type_en_cours; + (*s_etat_processus).type_en_cours = LST; + + if (recherche_instruction_suivante_recursive( + s_etat_processus, recursivite + 1) == d_erreur) { + (*s_etat_processus).type_en_cours = + registre_type_en_cours; + if ((*s_etat_processus).instruction_courante != NULL) { free((*s_etat_processus).instruction_courante); + (*s_etat_processus).instruction_courante = NULL; } return(d_erreur); } + (*s_etat_processus).type_en_cours = registre_type_en_cours; pointeur_caractere_courant = (*s_etat_processus).definitions_chainees + (*s_etat_processus).position_courante; - if (strcmp((*s_etat_processus).instruction_courante, "{") + 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) - { - 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++; - - if (niveau_annexe > 2) - { - erreur_analyse = d_ex_syntaxe; - } - } - else if (strcmp((*s_etat_processus).instruction_courante, - "[[") == 0) - { - niveau_annexe += 2; - - if (niveau_annexe > 2) - { - erreur_analyse = d_ex_syntaxe; - } - } - else if (strcmp((*s_etat_processus).instruction_courante, - "]") == 0) - { - niveau_annexe--; - - if (niveau_annexe < 0) - { - erreur_analyse = d_ex_syntaxe; - } - } - else if (strcmp((*s_etat_processus).instruction_courante, - "]]") == 0) - { - niveau_annexe -= 2; - - 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; - } - } free((*s_etat_processus).instruction_courante); } - if ((niveau != 0) || (niveau_annexe != 0)) + if (niveau != 0) { erreur_analyse = d_ex_syntaxe; } @@ -1626,51 +1594,78 @@ recherche_instruction_suivante(struct_pr erreur_format = d_ex_syntaxe; } - niveau = 1; + pointeur_caractere_courant++; + drapeau_fin_objet = d_faux; - while((niveau != 0) && ((*pointeur_caractere_courant) != - d_code_fin_chaine)) + while(((*pointeur_caractere_courant) != d_code_fin_chaine) + && (erreur_format == d_absence_erreur)) { - (*s_etat_processus).position_courante = - pointeur_caractere_courant - - (*s_etat_processus).definitions_chainees; + while((*pointeur_caractere_courant) == d_code_espace) + { + pointeur_caractere_courant++; + } - if (recherche_instruction_suivante(s_etat_processus) - == d_erreur) + if ((*pointeur_caractere_courant) == '>') { - if ((*s_etat_processus).instruction_courante - != NULL) + if ((*(++pointeur_caractere_courant)) == '>') + { + drapeau_fin_objet = d_vrai; + } + else { - free((*s_etat_processus).instruction_courante); + erreur_analyse = d_ex_syntaxe; } - return(d_erreur); + pointeur_caractere_courant++; + break; } - pointeur_caractere_courant = - (*s_etat_processus).definitions_chainees + - (*s_etat_processus).position_courante; - - if (strcmp((*s_etat_processus).instruction_courante, - "<<") == 0) - { - niveau++; - } - else if (strcmp((*s_etat_processus) - .instruction_courante, ">>") == 0) + if ((erreur_format == d_absence_erreur) && + (drapeau_fin_objet == d_faux)) { - niveau--; - } + (*s_etat_processus).position_courante = + pointeur_caractere_courant + - (*s_etat_processus).definitions_chainees; + + registre_type_en_cours = (*s_etat_processus) + .type_en_cours; + (*s_etat_processus).type_en_cours = RPN; + + if ((erreur = + recherche_instruction_suivante_recursive( + s_etat_processus, recursivite + 1)) + != d_absence_erreur) + { + (*s_etat_processus).type_en_cours = + registre_type_en_cours; + + if ((*s_etat_processus).instruction_courante + != NULL) + { + free((*s_etat_processus) + .instruction_courante); + (*s_etat_processus).instruction_courante + = NULL; + } - free((*s_etat_processus).instruction_courante); + return(d_erreur); + } + + (*s_etat_processus).type_en_cours = + registre_type_en_cours; + pointeur_caractere_courant = (*s_etat_processus) + .definitions_chainees + (*s_etat_processus) + .position_courante; + + free((*s_etat_processus).instruction_courante); + } } - if (niveau != 0) + if (drapeau_fin_objet == d_faux) { erreur_analyse = d_ex_syntaxe; + drapeau_fin_objet = d_vrai; } - - drapeau_fin_objet = d_vrai; } else if ((*pointeur_caractere_courant) == '[') { // Cas <[ ]> @@ -1713,19 +1708,32 @@ recherche_instruction_suivante(struct_pr pointeur_caractere_courant - (*s_etat_processus).definitions_chainees; - if ((erreur = recherche_instruction_suivante( - s_etat_processus)) != d_absence_erreur) + registre_type_en_cours = (*s_etat_processus) + .type_en_cours; + (*s_etat_processus).type_en_cours = TBL; + + if ((erreur = + recherche_instruction_suivante_recursive( + s_etat_processus, recursivite + 1)) + != d_absence_erreur) { + (*s_etat_processus).type_en_cours = + registre_type_en_cours; + if ((*s_etat_processus).instruction_courante != NULL) { free((*s_etat_processus) .instruction_courante); + (*s_etat_processus).instruction_courante + = NULL; } return(d_erreur); } + (*s_etat_processus).type_en_cours = + registre_type_en_cours; pointeur_caractere_courant = (*s_etat_processus) .definitions_chainees + (*s_etat_processus) .position_courante; @@ -1744,10 +1752,44 @@ recherche_instruction_suivante(struct_pr break; } } + + if ((*(pointeur_caractere_courant - 1)) == caractere_fin) + { + // Cas des objets composites (LST, RPN, TBL) + break; + } + else if ((*pointeur_caractere_courant) == caractere_fin) + { + // Condition pour traiter les cas 123} + break; + } } pointeur_fin_instruction = pointeur_caractere_courant; + if (recursivite == 0) + { + // Si la variable récursivité est nulle, il faut que le caractère + // suivant l'objet soit un espace ou une fin de chaîne. Si ce n'est pas + // le cas, il faut retourner une erreur car les objets de type + // [[ 1 4 ]]3 doivent être invalides. + + switch((*pointeur_fin_instruction)) + { + case d_code_fin_chaine: + case d_code_espace: + { + break; + } + + default: + { + (*s_etat_processus).erreur_execution = d_ex_syntaxe; + return(d_erreur); + } + } + } + (*s_etat_processus).instruction_courante = (unsigned char *) malloc((((size_t) (pointeur_fin_instruction - pointeur_debut_instruction)) + 1) * sizeof(unsigned char)); @@ -1788,11 +1830,11 @@ recherche_instruction_suivante(struct_pr /* ================================================================================ - Routine mettant la chaine d'entrée en majuscule + Routine mettant la chaîne d'entrée en majuscule ================================================================================ - Entrée : pointeur sur une chaine en minuscules. + Entrée : pointeur sur une chaîne en minuscules. -------------------------------------------------------------------------------- - Sortie : pointeur sur la chaine en majuscules. Si le pointeur retourné + Sortie : pointeur sur la chaîne en majuscules. Si le pointeur retourné est nul, il s'est produit une erreur. L'allocation est faite dans la routine. --------------------------------------------------------------------------------