--- rpl/src/compilation.c 2011/04/11 12:10:04 1.24 +++ rpl/src/compilation.c 2013/09/06 10:30:50 1.63 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.1.0.prerelease.0 - Copyright (C) 1989-2011 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.16 + Copyright (C) 1989-2013 Dr. BERTRAND Joël This file is part of RPL/2. @@ -54,15 +54,15 @@ compilation(struct_processus *s_etat_pro unsigned char ouverture_definition; unsigned char position_debut_nom_definition_valide; - unsigned long *adresse; - unsigned long i; - unsigned long niveau_definition; - unsigned long niveau_definition_registre; - unsigned long position_courante; - unsigned long position_debut_nom_definition; - unsigned long position_fin_nom_definition; - unsigned long validation; - unsigned long validation_registre; + integer8 *adresse; + integer8 i; + integer8 niveau_definition; + integer8 niveau_definition_registre; + integer8 position_courante; + integer8 position_debut_nom_definition; + integer8 position_fin_nom_definition; + integer8 validation; + integer8 validation_registre; (*s_etat_processus).erreur_compilation = d_ec; (*s_etat_processus).erreur_systeme = d_es; @@ -257,9 +257,9 @@ compilation(struct_processus *s_etat_pro s_variable = (struct_variable *) malloc(sizeof(struct_variable)); adresse = (*s_objet).objet; - definition = (unsigned char *) malloc( + definition = (unsigned char *) malloc(((size_t) (position_fin_nom_definition - - position_debut_nom_definition + 2) * + position_debut_nom_definition + 2)) * sizeof(unsigned char)); if ((s_objet == NULL) || (s_variable == NULL) || @@ -358,84 +358,84 @@ compilation(struct_processus *s_etat_pro ================================================================================ */ -logical1 -analyse_syntaxique(struct_processus *s_etat_processus) -{ - enum t_condition { AN_IF = 1, AN_IFERR, AN_THEN, AN_ELSE, AN_ELSEIF, - AN_END, AN_DO, AN_UNTIL, AN_WHILE, AN_REPEAT, AN_SELECT, - AN_CASE, AN_DEFAULT, AN_UP, AN_DOWN, AN_FOR, AN_START, - AN_NEXT, AN_STEP }; - - unsigned char *instruction; - unsigned char registre; - - typedef struct pile - { - enum t_condition condition; - struct pile *suivant; - } struct_pile_analyse; +enum t_condition { AN_IF = 1, AN_IFERR, AN_THEN, AN_ELSE, AN_ELSEIF, + AN_END, AN_DO, AN_UNTIL, AN_WHILE, AN_REPEAT, AN_SELECT, + AN_CASE, AN_DEFAULT, AN_UP, AN_DOWN, AN_FOR, AN_START, + AN_NEXT, AN_STEP, AN_CRITICAL, AN_FORALL }; - struct_pile_analyse *l_base_pile; - struct_pile_analyse *l_nouvelle_base_pile; +typedef struct pile +{ + enum t_condition condition; + struct pile *suivant; +} struct_pile_analyse; + +static inline struct_pile_analyse * +empilement_analyse(struct_pile_analyse *ancienne_base, + enum t_condition condition) +{ + struct_pile_analyse *nouvelle_base; - inline struct_pile_analyse * - empilement_analyse(struct_pile_analyse *ancienne_base, - enum t_condition condition) + if ((nouvelle_base = malloc(sizeof(struct_pile_analyse))) == NULL) { - struct_pile_analyse *nouvelle_base; + return(NULL); + } - if ((nouvelle_base = malloc(sizeof(struct_pile_analyse))) == NULL) - { - return(NULL); - } + (*nouvelle_base).suivant = ancienne_base; + (*nouvelle_base).condition = condition; - (*nouvelle_base).suivant = ancienne_base; - (*nouvelle_base).condition = condition; + return(nouvelle_base); +} - return(nouvelle_base); - } +static inline struct_pile_analyse * +depilement_analyse(struct_pile_analyse *ancienne_base) +{ + struct_pile_analyse *nouvelle_base; - inline struct_pile_analyse * - depilement_analyse(struct_pile_analyse *ancienne_base) + if (ancienne_base == NULL) { - struct_pile_analyse *nouvelle_base; + return(NULL); + } - if (ancienne_base == NULL) - { - return(NULL); - } + nouvelle_base = (*ancienne_base).suivant; + free(ancienne_base); - nouvelle_base = (*ancienne_base).suivant; - free(ancienne_base); + return(nouvelle_base); +} - return(nouvelle_base); +static inline logical1 +test_analyse(struct_pile_analyse *l_base_pile, enum t_condition condition) +{ + if (l_base_pile == NULL) + { + return(d_faux); } - inline logical1 - test_analyse(struct_pile_analyse *l_base_pile, enum t_condition condition) - { - if (l_base_pile == NULL) - { - return(d_faux); - } + return(((*l_base_pile).condition == condition) ? d_vrai : d_faux); +} - return(((*l_base_pile).condition == condition) ? d_vrai : d_faux); - } +static inline void +liberation_analyse(struct_pile_analyse *l_base_pile) +{ + struct_pile_analyse *l_nouvelle_base_pile; - inline void - liberation_analyse(struct_pile_analyse *l_base_pile) + while(l_base_pile != NULL) { - struct_pile_analyse *l_nouvelle_base_pile; + l_nouvelle_base_pile = (*l_base_pile).suivant; + free(l_base_pile); + l_base_pile = l_nouvelle_base_pile; + } - while(l_base_pile != NULL) - { - l_nouvelle_base_pile = (*l_base_pile).suivant; - free(l_base_pile); - l_base_pile = l_nouvelle_base_pile; - } + return; +} - return; - } +logical1 +analyse_syntaxique(struct_processus *s_etat_processus) +{ + unsigned char *instruction; + unsigned char registre; + + struct_pile_analyse *l_base_pile; + struct_pile_analyse *l_nouvelle_base_pile; l_base_pile = NULL; l_nouvelle_base_pile = NULL; @@ -514,6 +514,19 @@ analyse_syntaxique(struct_processus *s_e l_base_pile = l_nouvelle_base_pile; } + else if (strcmp(instruction, "CRITICAL") == 0) + { + if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, + AN_CRITICAL)) == NULL) + { + liberation_analyse(l_base_pile); + + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; + return(d_erreur); + } + + l_base_pile = l_nouvelle_base_pile; + } else if (strcmp(instruction, "THEN") == 0) { if ((test_analyse(l_base_pile, AN_IF) == d_faux) && @@ -572,6 +585,7 @@ analyse_syntaxique(struct_processus *s_e (test_analyse(l_base_pile, AN_DEFAULT) == d_faux) && (test_analyse(l_base_pile, AN_SELECT) == d_faux) && (test_analyse(l_base_pile, AN_THEN) == d_faux) && + (test_analyse(l_base_pile, AN_CRITICAL) == d_faux) && (test_analyse(l_base_pile, AN_ELSE) == d_faux)) { liberation_analyse(l_base_pile); @@ -753,9 +767,23 @@ analyse_syntaxique(struct_processus *s_e l_base_pile = l_nouvelle_base_pile; } + else if (strcmp(instruction, "FORALL") == 0) + { + if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, + AN_FORALL)) == NULL) + { + liberation_analyse(l_base_pile); + + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; + return(d_erreur); + } + + l_base_pile = l_nouvelle_base_pile; + } else if (strcmp(instruction, "NEXT") == 0) { if ((test_analyse(l_base_pile, AN_FOR) == d_faux) && + (test_analyse(l_base_pile, AN_FORALL) == d_faux) && (test_analyse(l_base_pile, AN_START) == d_faux)) { liberation_analyse(l_base_pile); @@ -811,6 +839,134 @@ 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 : @@ -824,13 +980,13 @@ analyse_syntaxique(struct_processus *s_e */ void -swap(void *variable_1, void *variable_2, unsigned long taille) +swap(void *variable_1, void *variable_2, integer8 taille) { register unsigned char *t_var_1; register unsigned char *t_var_2; register unsigned char variable_temporaire; - register unsigned long i; + register integer8 i; t_var_1 = (unsigned char *) variable_1; t_var_2 = (unsigned char *) variable_2; @@ -863,8 +1019,9 @@ recherche_instruction_suivante(struct_pr { logical1 drapeau_fin_objet; logical1 erreur; - logical1 erreur_analyse; - logical1 erreur_format; + + int erreur_analyse; + int erreur_format; unsigned char base_binaire; unsigned char *pointeur_caractere_courant; @@ -924,6 +1081,10 @@ recherche_instruction_suivante(struct_pr { case ']' : case '}' : + { + break; + } + case ')' : { erreur_format = d_ex_syntaxe; @@ -1262,100 +1423,109 @@ recherche_instruction_suivante(struct_pr while((niveau != 0) && ((*pointeur_caractere_courant) != d_code_fin_chaine)) { - switch(*pointeur_caractere_courant) + (*s_etat_processus).position_courante = + pointeur_caractere_courant + - (*s_etat_processus).definitions_chainees; + + if (recherche_instruction_suivante(s_etat_processus) + == d_erreur) { - case '{' : + if ((*s_etat_processus).instruction_courante + != NULL) { - if (niveau_annexe == 0) - { - niveau++; - } - else - { - erreur_analyse = d_ex_syntaxe; - } - - break; + free((*s_etat_processus).instruction_courante); } - case '}' : - { - if (niveau_annexe == 0) - { - niveau--; - } - else - { - erreur_analyse = d_ex_syntaxe; - } + return(d_erreur); + } - break; - } + pointeur_caractere_courant = + (*s_etat_processus).definitions_chainees + + (*s_etat_processus).position_courante; - case '[' : + if (strcmp((*s_etat_processus).instruction_courante, "{") + == 0) + { + if (niveau_annexe == 0) { - niveau_annexe++; - - if (niveau_annexe > 2) - { - erreur_analyse = d_ex_syntaxe; - } - - break; + niveau++; } - - case ']' : + else { - niveau_annexe--; - - if (niveau_annexe < 0) - { - erreur_analyse = d_ex_syntaxe; - } + 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++; - break; + if (niveau_annexe > 2) + { + erreur_analyse = d_ex_syntaxe; } + } + else if (strcmp((*s_etat_processus).instruction_courante, + "[[") == 0) + { + niveau_annexe += 2; - case '"' : + if (niveau_annexe > 2) { - if (niveau_annexe == 0) - { - pointeur_caractere_courant++; + erreur_analyse = d_ex_syntaxe; + } + } + else if (strcmp((*s_etat_processus).instruction_courante, + "]") == 0) + { + niveau_annexe--; - while((*pointeur_caractere_courant != '"') && - ((*pointeur_caractere_courant) != - d_code_fin_chaine)) - { - if (*pointeur_caractere_courant == '\\') - { - pointeur_caractere_courant++; - - switch(*pointeur_caractere_courant) - { - case '\\' : - case '"' : - { - pointeur_caractere_courant++; - break; - } - } - } - else - { - pointeur_caractere_courant++; - } - } - } - else - { - erreur_analyse = d_ex_syntaxe; - } + if (niveau_annexe < 0) + { + erreur_analyse = d_ex_syntaxe; + } + } + else if (strcmp((*s_etat_processus).instruction_courante, + "]]") == 0) + { + niveau_annexe -= 2; - break; + 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; } } - pointeur_caractere_courant++; + free((*s_etat_processus).instruction_courante); } if ((niveau != 0) || (niveau_annexe != 0)) @@ -1449,7 +1619,7 @@ recherche_instruction_suivante(struct_pr { if (((*s_etat_processus).autorisation_empilement_programme == 'Y') && ((*pointeur_caractere_courant) == '<')) - { + { // Cas << >> if (pointeur_debut_instruction != (pointeur_caractere_courant - 1)) { @@ -1461,48 +1631,38 @@ recherche_instruction_suivante(struct_pr while((niveau != 0) && ((*pointeur_caractere_courant) != d_code_fin_chaine)) { - if (((*pointeur_caractere_courant) == '<') && - ((*(pointeur_caractere_courant + 1)) == '<')) + (*s_etat_processus).position_courante = + pointeur_caractere_courant + - (*s_etat_processus).definitions_chainees; + + if (recherche_instruction_suivante(s_etat_processus) + == d_erreur) { - niveau++; - pointeur_caractere_courant++; + if ((*s_etat_processus).instruction_courante + != NULL) + { + free((*s_etat_processus).instruction_courante); + } + + return(d_erreur); } - else if (((*pointeur_caractere_courant) == '>') && - ((*(pointeur_caractere_courant + 1)) == '>')) + + pointeur_caractere_courant = + (*s_etat_processus).definitions_chainees + + (*s_etat_processus).position_courante; + + if (strcmp((*s_etat_processus).instruction_courante, + "<<") == 0) { - niveau--; - pointeur_caractere_courant++; + niveau++; } - else if ((*pointeur_caractere_courant) == '"') + else if (strcmp((*s_etat_processus) + .instruction_courante, ">>") == 0) { - pointeur_caractere_courant++; - - while((*pointeur_caractere_courant != '"') && - ((*pointeur_caractere_courant) != - d_code_fin_chaine)) - { - if (*pointeur_caractere_courant == '\\') - { - pointeur_caractere_courant++; - - switch(*pointeur_caractere_courant) - { - case '\\' : - case '"' : - { - pointeur_caractere_courant++; - break; - } - } - } - else - { - pointeur_caractere_courant++; - } - } + niveau--; } - pointeur_caractere_courant++; + free((*s_etat_processus).instruction_courante); } if (niveau != 0) @@ -1513,7 +1673,7 @@ recherche_instruction_suivante(struct_pr drapeau_fin_objet = d_vrai; } else if ((*pointeur_caractere_courant) == '[') - { + { // Cas <[ ]> if (pointeur_debut_instruction != (pointeur_caractere_courant - 1)) { @@ -1589,8 +1749,8 @@ recherche_instruction_suivante(struct_pr pointeur_fin_instruction = pointeur_caractere_courant; (*s_etat_processus).instruction_courante = (unsigned char *) - malloc(((pointeur_fin_instruction - pointeur_debut_instruction) - + 1) * sizeof(unsigned char)); + malloc((((size_t) (pointeur_fin_instruction + - pointeur_debut_instruction)) + 1) * sizeof(unsigned char)); if ((*s_etat_processus).instruction_courante == NULL) { @@ -1647,7 +1807,7 @@ conversion_majuscule(unsigned char *chai register unsigned char *caractere_courant_converti; register unsigned char *chaine_convertie; - unsigned long longueur_chaine_plus_terminaison; + integer8 longueur_chaine_plus_terminaison; longueur_chaine_plus_terminaison = 0; caractere_courant = chaine; @@ -1660,7 +1820,8 @@ conversion_majuscule(unsigned char *chai caractere_courant = chaine; caractere_courant_converti = chaine_convertie = (unsigned char *) malloc( - (longueur_chaine_plus_terminaison + 1) * sizeof(unsigned char)); + ((size_t) (longueur_chaine_plus_terminaison + 1)) + * sizeof(unsigned char)); if (chaine_convertie != NULL) { @@ -1688,9 +1849,9 @@ conversion_majuscule(unsigned char *chai void conversion_majuscule_limitee(unsigned char *chaine_entree, - unsigned char *chaine_sortie, unsigned long longueur) + unsigned char *chaine_sortie, integer8 longueur) { - unsigned long i; + integer8 i; for(i = 0; i < longueur; i++) { @@ -1734,7 +1895,7 @@ initialisation_drapeaux(struct_processus { unsigned long i; - for(i = 0; i < 31; cf(s_etat_processus, i++)); + for(i = 0; i < 31; cf(s_etat_processus, (unsigned char) i++)); if ((*s_etat_processus).lancement_interactif == d_vrai) {