--- rpl/src/compilation.c 2015/01/05 13:12:29 1.70 +++ rpl/src/compilation.c 2017/07/02 22:28:20 1.91 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.1.19 - Copyright (C) 1989-2015 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.27 + Copyright (C) 1989-2017 Dr. BERTRAND Joël This file is part of RPL/2. @@ -20,7 +20,6 @@ */ -#define DEBUG_ERREURS #include "rpl-conv.h" @@ -282,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++]; } @@ -291,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" @@ -312,7 +322,6 @@ compilation(struct_processus *s_etat_pro if ((*s_etat_processus).erreur_systeme != d_es) { free(s_variable); - return(d_erreur); } @@ -371,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; @@ -388,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; @@ -415,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; @@ -472,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; @@ -490,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); @@ -504,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); @@ -517,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); @@ -535,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; @@ -551,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; @@ -567,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; @@ -589,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; @@ -599,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); @@ -618,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; @@ -632,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); @@ -647,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; @@ -661,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); @@ -676,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; @@ -686,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); @@ -701,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; @@ -715,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); @@ -730,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; @@ -740,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); @@ -757,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); @@ -770,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); @@ -787,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; @@ -797,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; @@ -814,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 @@ -827,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; @@ -840,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 : @@ -1033,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; @@ -1042,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; @@ -1106,6 +996,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) && @@ -1605,19 +1540,30 @@ recherche_instruction_suivante_recursive pointeur_caractere_courant++; } - if ((*pointeur_caractere_courant) == '>') + if (((*pointeur_caractere_courant) == '>') && + ((*(pointeur_caractere_courant - 1)) == + d_code_espace)) { - if ((*(++pointeur_caractere_courant)) == '>') - { + pointeur_caractere_courant++; + + if ((*pointeur_caractere_courant) == '>') + { // Cas de '>>' drapeau_fin_objet = d_vrai; + pointeur_caractere_courant++; + break; } - else - { + 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++; - break; + pointeur_caractere_courant--; } if ((erreur_format == d_absence_erreur) && @@ -1760,7 +1706,7 @@ recherche_instruction_suivante_recursive } else if ((*pointeur_caractere_courant) == caractere_fin) { - // Condition pour traiter les cas 123} + // Condition pour traiter les cas "123}" break; } } @@ -1785,7 +1731,7 @@ recherche_instruction_suivante_recursive default: { (*s_etat_processus).erreur_execution = d_ex_syntaxe; - return(d_erreur); +// return(d_erreur); } } } @@ -1815,6 +1761,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 { @@ -1843,7 +1794,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;