--- rpl/src/compilation.c 2014/08/04 06:58:48 1.69 +++ rpl/src/compilation.c 2020/01/10 11:15:41 1.99 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.1.19 - Copyright (C) 1989-2014 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.32 + Copyright (C) 1989-2020 Dr. BERTRAND Joël This file is part of RPL/2. @@ -19,7 +19,7 @@ ================================================================================ */ -#define DEBUG_ERREURS + #include "rpl-conv.h" @@ -281,6 +281,15 @@ compilation(struct_processus *s_etat_pro while(i <= position_fin_nom_definition) { + if ((*s_etat_processus).pointeurs_caracteres_variables + [(*s_etat_processus).definitions_chainees[i]] < 0) + { + free(s_variable); + + (*s_etat_processus).erreur_execution = d_ex_syntaxe; + return(d_erreur); + } + *(definition++) = (*s_etat_processus) .definitions_chainees[i++]; } @@ -290,6 +299,8 @@ compilation(struct_processus *s_etat_pro if (recherche_variable(s_etat_processus, (*s_variable).nom) == d_vrai) { + free(s_variable); + if ((*s_etat_processus).langue == 'F') { printf("+++Attention : Plusieurs définitions de" @@ -311,7 +322,6 @@ compilation(struct_processus *s_etat_pro if ((*s_etat_processus).erreur_systeme != d_es) { free(s_variable); - return(d_erreur); } @@ -370,7 +380,8 @@ typedef struct pile } struct_pile_analyse; static inline struct_pile_analyse * -empilement_analyse(struct_pile_analyse *ancienne_base, +empilement_analyse(struct_processus *s_etat_processus, + struct_pile_analyse *ancienne_base, enum t_condition condition) { struct_pile_analyse *nouvelle_base; @@ -387,7 +398,8 @@ empilement_analyse(struct_pile_analyse * } static inline struct_pile_analyse * -depilement_analyse(struct_pile_analyse *ancienne_base) +depilement_analyse(struct_processus *s_etat_processus, + struct_pile_analyse *ancienne_base) { struct_pile_analyse *nouvelle_base; @@ -414,7 +426,8 @@ test_analyse(struct_pile_analyse *l_base } static inline void -liberation_analyse(struct_pile_analyse *l_base_pile) +liberation_analyse(struct_processus *s_etat_processus, + struct_pile_analyse *l_base_pile) { struct_pile_analyse *l_nouvelle_base_pile; @@ -471,16 +484,16 @@ analyse_syntaxique(struct_processus *s_e if (recherche_instruction_suivante(s_etat_processus) != d_absence_erreur) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).autorisation_empilement_programme = registre; return(d_erreur); } - if ((instruction = conversion_majuscule( + if ((instruction = conversion_majuscule(s_etat_processus, (*s_etat_processus).instruction_courante)) == NULL) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).autorisation_empilement_programme = registre; (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -489,10 +502,10 @@ analyse_syntaxique(struct_processus *s_e if (strcmp(instruction, "IF") == 0) { - if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, AN_IF)) - == NULL) + if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus, + l_base_pile, AN_IF)) == NULL) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return(d_erreur); @@ -503,10 +516,10 @@ analyse_syntaxique(struct_processus *s_e } else if (strcmp(instruction, "IFERR") == 0) { - if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, - AN_IFERR)) == NULL) + if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus, + l_base_pile, AN_IFERR)) == NULL) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return(d_erreur); @@ -516,10 +529,10 @@ analyse_syntaxique(struct_processus *s_e } else if (strcmp(instruction, "CRITICAL") == 0) { - if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, - AN_CRITICAL)) == NULL) + if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus, + l_base_pile, AN_CRITICAL)) == NULL) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return(d_erreur); @@ -534,7 +547,7 @@ analyse_syntaxique(struct_processus *s_e (test_analyse(l_base_pile, AN_CASE) == d_faux) && (test_analyse(l_base_pile, AN_IFERR) == d_faux)) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).autorisation_empilement_programme = registre; @@ -550,7 +563,7 @@ analyse_syntaxique(struct_processus *s_e { if (test_analyse(l_base_pile, AN_THEN) == d_faux) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).autorisation_empilement_programme = registre; @@ -566,7 +579,7 @@ analyse_syntaxique(struct_processus *s_e { if (test_analyse(l_base_pile, AN_THEN) == d_faux) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).autorisation_empilement_programme = registre; @@ -588,7 +601,7 @@ analyse_syntaxique(struct_processus *s_e (test_analyse(l_base_pile, AN_CRITICAL) == d_faux) && (test_analyse(l_base_pile, AN_ELSE) == d_faux)) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).autorisation_empilement_programme = registre; @@ -598,14 +611,14 @@ analyse_syntaxique(struct_processus *s_e return(d_erreur); } - l_base_pile = depilement_analyse(l_base_pile); + l_base_pile = depilement_analyse(s_etat_processus, l_base_pile); } else if (strcmp(instruction, "DO") == 0) { - if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, AN_DO)) - == NULL) + if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus, + l_base_pile, AN_DO)) == NULL) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return(d_erreur); @@ -617,7 +630,7 @@ analyse_syntaxique(struct_processus *s_e { if (test_analyse(l_base_pile, AN_DO) == d_faux) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).autorisation_empilement_programme = registre; @@ -631,10 +644,10 @@ analyse_syntaxique(struct_processus *s_e } else if (strcmp(instruction, "WHILE") == 0) { - if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, - AN_WHILE)) == NULL) + if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus, + l_base_pile, AN_WHILE)) == NULL) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return(d_erreur); @@ -646,7 +659,7 @@ analyse_syntaxique(struct_processus *s_e { if (test_analyse(l_base_pile, AN_WHILE) == d_faux) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).autorisation_empilement_programme = registre; @@ -660,10 +673,10 @@ analyse_syntaxique(struct_processus *s_e } else if (strcmp(instruction, "SELECT") == 0) { - if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, - AN_SELECT)) == NULL) + if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus, + l_base_pile, AN_SELECT)) == NULL) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return(d_erreur); @@ -675,7 +688,7 @@ analyse_syntaxique(struct_processus *s_e { if (test_analyse(l_base_pile, AN_SELECT) == d_faux) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).autorisation_empilement_programme = registre; @@ -685,10 +698,10 @@ analyse_syntaxique(struct_processus *s_e return(d_erreur); } - if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, - AN_CASE)) == NULL) + if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus, + l_base_pile, AN_CASE)) == NULL) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return(d_erreur); @@ -700,7 +713,7 @@ analyse_syntaxique(struct_processus *s_e { if (test_analyse(l_base_pile, AN_SELECT) == d_faux) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).autorisation_empilement_programme = registre; @@ -714,10 +727,10 @@ analyse_syntaxique(struct_processus *s_e } else if (strcmp(instruction, "<<") == 0) { - if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, AN_UP)) - == NULL) + if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus, + l_base_pile, AN_UP)) == NULL) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return(d_erreur); @@ -729,7 +742,7 @@ analyse_syntaxique(struct_processus *s_e { if (test_analyse(l_base_pile, AN_UP) == d_faux) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).autorisation_empilement_programme = registre; @@ -739,14 +752,14 @@ analyse_syntaxique(struct_processus *s_e return(d_erreur); } - l_base_pile = depilement_analyse(l_base_pile); + l_base_pile = depilement_analyse(s_etat_processus, l_base_pile); } else if (strcmp(instruction, "FOR") == 0) { - if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, AN_FOR)) - == NULL) + if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus, + l_base_pile, AN_FOR)) == NULL) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return(d_erreur); @@ -756,10 +769,10 @@ analyse_syntaxique(struct_processus *s_e } else if (strcmp(instruction, "START") == 0) { - if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, - AN_START)) == NULL) + if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus, + l_base_pile, AN_START)) == NULL) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return(d_erreur); @@ -769,10 +782,10 @@ analyse_syntaxique(struct_processus *s_e } else if (strcmp(instruction, "FORALL") == 0) { - if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, - AN_FORALL)) == NULL) + if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus, + l_base_pile, AN_FORALL)) == NULL) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return(d_erreur); @@ -786,7 +799,7 @@ analyse_syntaxique(struct_processus *s_e (test_analyse(l_base_pile, AN_FORALL) == d_faux) && (test_analyse(l_base_pile, AN_START) == d_faux)) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).autorisation_empilement_programme = registre; @@ -796,14 +809,14 @@ analyse_syntaxique(struct_processus *s_e return(d_erreur); } - l_base_pile = depilement_analyse(l_base_pile); + l_base_pile = depilement_analyse(s_etat_processus, l_base_pile); } else if (strcmp(instruction, "STEP") == 0) { if ((test_analyse(l_base_pile, AN_FOR) == d_faux) && (test_analyse(l_base_pile, AN_START) == d_faux)) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).autorisation_empilement_programme = registre; @@ -813,7 +826,7 @@ analyse_syntaxique(struct_processus *s_e return(d_erreur); } - l_base_pile = depilement_analyse(l_base_pile); + l_base_pile = depilement_analyse(s_etat_processus, l_base_pile); } // Invalidation de l'instruction courante dans le fichier rpl-core @@ -826,7 +839,7 @@ analyse_syntaxique(struct_processus *s_e if (l_base_pile != NULL) { - liberation_analyse(l_base_pile); + liberation_analyse(s_etat_processus, l_base_pile); (*s_etat_processus).autorisation_empilement_programme = registre; (*s_etat_processus).erreur_compilation = d_ec_source_incoherent; @@ -839,134 +852,6 @@ analyse_syntaxique(struct_processus *s_e /* ================================================================================ - Procédure de d'analyse syntaxique du source pour readline -================================================================================ - Entrées : --------------------------------------------------------------------------------- - Sorties : - - rl_done à 0 ou à 1. --------------------------------------------------------------------------------- - Effets de bord : -================================================================================ -*/ - -static char *ligne = NULL; -static unsigned int niveau = 0; - -int -readline_analyse_syntaxique(int count, int key) -{ - char prompt[] = "+ %03d> "; - char prompt2[8]; - char *registre; - - struct_processus s_etat_processus; - - if ((*rl_line_buffer) == d_code_fin_chaine) - { - 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 - { - 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); -} - - -/* -================================================================================ Routine d'échange de deux variables ================================================================================ Entrées : @@ -1032,6 +917,10 @@ recherche_instruction_suivante_recursive int erreur_analyse; int erreur_format; + integer8 nombre_caracteres; + integer8 (*__type_parse)(struct_processus *, void **); + + unsigned char base_binaire; unsigned char caractere_fin; unsigned char *pointeur_caractere_courant; @@ -1041,6 +930,8 @@ recherche_instruction_suivante_recursive signed long niveau; + struct_liste_chainee *l_element_courant; + erreur_analyse = d_ex; erreur_format = d_ex; erreur = d_absence_erreur; @@ -1060,6 +951,7 @@ recherche_instruction_suivante_recursive } case TBL: + case REC: { caractere_fin = ']'; break; @@ -1105,6 +997,51 @@ recherche_instruction_suivante_recursive return(erreur); } + /* + * On regarde s'il existe des fonctions permettant de parser + * les objets dans les bibliothèques externes. + */ + + l_element_courant = (*s_etat_processus).s_bibliotheques; + (*s_etat_processus).position_courante = pointeur_caractere_courant + - (*s_etat_processus).definitions_chainees; + + while(l_element_courant != NULL) + { + if ((__type_parse = dlsym((*((struct_bibliotheque *) + (*l_element_courant).donnee)).descripteur, "__type_parse")) + != NULL) + { + // Une fonction declareTypeExtension(parse) se trouve dans la + // bibliothèque. Si cette fonction renvoie une valeur non nulle, + // elle a réussi à parser correctement un objet. + + if ((nombre_caracteres = __type_parse(s_etat_processus, NULL)) != 0) + { + if (((*s_etat_processus).instruction_courante = + malloc((((unsigned) nombre_caracteres) + 1) + * sizeof(unsigned char))) == NULL) + { + (*s_etat_processus).erreur_systeme = + d_es_allocation_memoire; + return(d_erreur); + } + + strncpy((*s_etat_processus).instruction_courante, + (*s_etat_processus).definitions_chainees + + (*s_etat_processus).position_courante, + (unsigned) nombre_caracteres); + (*s_etat_processus).instruction_courante[nombre_caracteres] + = d_code_fin_chaine; + + (*s_etat_processus).position_courante += nombre_caracteres; + return(erreur); + } + } + + l_element_courant = (*l_element_courant).suivant; + } + pointeur_debut_instruction = pointeur_caractere_courant; while(((*pointeur_caractere_courant) != d_code_espace) && @@ -1604,7 +1541,99 @@ recherche_instruction_suivante_recursive pointeur_caractere_courant++; } - if ((*pointeur_caractere_courant) == '>') + if (((*pointeur_caractere_courant) == '>') && + ((*(pointeur_caractere_courant - 1)) == + d_code_espace)) + { + pointeur_caractere_courant++; + + if ((*pointeur_caractere_courant) == '>') + { // Cas de '>>' + drapeau_fin_objet = d_vrai; + pointeur_caractere_courant++; + break; + } + else if ((*pointeur_caractere_courant) == '=') + { // Cas de '>=' + pointeur_caractere_courant++; + } + else if ((*pointeur_caractere_courant) != + d_code_espace) + { // Tous les cas différents de '>' + erreur_analyse = d_ex_syntaxe; + break; + } + + pointeur_caractere_courant--; + } + + if ((erreur_format == d_absence_erreur) && + (drapeau_fin_objet == d_faux)) + { + (*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; + } + + 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 (drapeau_fin_objet == d_faux) + { + erreur_analyse = d_ex_syntaxe; + drapeau_fin_objet = d_vrai; + } + } + else if ((*pointeur_caractere_courant) == '[') + { // Cas <[ ]> + if (pointeur_debut_instruction != + (pointeur_caractere_courant - 1)) + { + erreur_format = d_ex_syntaxe; + } + + pointeur_caractere_courant++; + drapeau_fin_objet = d_faux; + + while(((*pointeur_caractere_courant) != d_code_fin_chaine) + && (erreur_format == d_absence_erreur)) + { + while((*pointeur_caractere_courant) == d_code_espace) + { + pointeur_caractere_courant++; + } + + if ((*pointeur_caractere_courant) == ']') { if ((*(++pointeur_caractere_courant)) == '>') { @@ -1628,7 +1657,7 @@ recherche_instruction_suivante_recursive registre_type_en_cours = (*s_etat_processus) .type_en_cours; - (*s_etat_processus).type_en_cours = RPN; + (*s_etat_processus).type_en_cours = TBL; if ((erreur = recherche_instruction_suivante_recursive( @@ -1666,8 +1695,14 @@ recherche_instruction_suivante_recursive drapeau_fin_objet = d_vrai; } } - else if ((*pointeur_caractere_courant) == '[') - { // Cas <[ ]> + + break; + } + + case '|' : + { + if ((*pointeur_caractere_courant) == '[') + { // Cas |[ ]| if (pointeur_debut_instruction != (pointeur_caractere_courant - 1)) { @@ -1687,7 +1722,7 @@ recherche_instruction_suivante_recursive if ((*pointeur_caractere_courant) == ']') { - if ((*(++pointeur_caractere_courant)) == '>') + if ((*(++pointeur_caractere_courant)) == '|') { drapeau_fin_objet = d_vrai; } @@ -1709,7 +1744,7 @@ recherche_instruction_suivante_recursive registre_type_en_cours = (*s_etat_processus) .type_en_cours; - (*s_etat_processus).type_en_cours = TBL; + (*s_etat_processus).type_en_cours = REC; if ((erreur = recherche_instruction_suivante_recursive( @@ -1754,12 +1789,12 @@ recherche_instruction_suivante_recursive if ((*(pointeur_caractere_courant - 1)) == caractere_fin) { - // Cas des objets composites (LST, RPN, TBL) + // Cas des objets composites (LST, RPN, TBL, REC) break; } else if ((*pointeur_caractere_courant) == caractere_fin) { - // Condition pour traiter les cas 123} + // Condition pour traiter les cas "123}" break; } } @@ -1784,7 +1819,7 @@ recherche_instruction_suivante_recursive default: { (*s_etat_processus).erreur_execution = d_ex_syntaxe; - return(d_erreur); +// return(d_erreur); } } } @@ -1814,6 +1849,11 @@ recherche_instruction_suivante_recursive erreur = ((erreur_analyse == d_ex) && (erreur_format == d_ex)) ? d_absence_erreur : d_erreur; (*s_etat_processus).erreur_execution = erreur_analyse; + + if ((*s_etat_processus).erreur_execution == d_ex) + { + (*s_etat_processus).erreur_execution = erreur_format; + } } else { @@ -1842,7 +1882,7 @@ recherche_instruction_suivante_recursive */ unsigned char * -conversion_majuscule(unsigned char *chaine) +conversion_majuscule(struct_processus *s_etat_processus, unsigned char *chaine) { register unsigned char *caractere_courant; register unsigned char *caractere_courant_converti;