Diff for /rpl/src/compilation.c between versions 1.65 and 1.71

version 1.65, 2014/01/26 18:21:29 version 1.71, 2015/01/05 15:32:12
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.1.17    RPL/2 (R) version 4.1.20
   Copyright (C) 1989-2014 Dr. BERTRAND Joël    Copyright (C) 1989-2015 Dr. BERTRAND Joël
   
   This file is part of RPL/2.    This file is part of RPL/2.
   
Line 20 Line 20
 */  */
   
   
   #define DEBUG_ERREURS
 #include "rpl-conv.h"  #include "rpl-conv.h"
   
   
Line 1017  swap(void *variable_1, void *variable_2, Line 1018  swap(void *variable_1, void *variable_2,
 logical1  logical1
 recherche_instruction_suivante(struct_processus *s_etat_processus)  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                    drapeau_fin_objet;
     logical1                    erreur;      logical1                    erreur;
   
Line 1024  recherche_instruction_suivante(struct_pr Line 1034  recherche_instruction_suivante(struct_pr
     int                         erreur_format;      int                         erreur_format;
   
     unsigned char               base_binaire;      unsigned char               base_binaire;
       unsigned char               caractere_fin;
     unsigned char               *pointeur_caractere_courant;      unsigned char               *pointeur_caractere_courant;
     unsigned char               *pointeur_caractere_destination;      unsigned char               *pointeur_caractere_destination;
     unsigned char               *pointeur_debut_instruction;      unsigned char               *pointeur_debut_instruction;
     unsigned char               *pointeur_fin_instruction;      unsigned char               *pointeur_fin_instruction;
   
     signed long                 niveau;      signed long                 niveau;
     signed long                 niveau_annexe;  
   
     erreur_analyse = d_ex;      erreur_analyse = d_ex;
     erreur_format = d_ex;      erreur_format = d_ex;
     erreur = d_absence_erreur;      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;      drapeau_fin_objet = d_faux;
     niveau = 0;      niveau = 0;
   
Line 1074  recherche_instruction_suivante(struct_pr Line 1111  recherche_instruction_suivante(struct_pr
     while(((*pointeur_caractere_courant) != d_code_espace) &&      while(((*pointeur_caractere_courant) != d_code_espace) &&
             ((*pointeur_caractere_courant) != d_code_fin_chaine) &&              ((*pointeur_caractere_courant) != d_code_fin_chaine) &&
             (drapeau_fin_objet == d_faux) &&              (drapeau_fin_objet == d_faux) &&
             (erreur_analyse == d_ex) &&              (erreur_analyse == d_ex) && (erreur_format == d_ex))
             (erreur_format == d_ex))  
     {      {
         switch(*pointeur_caractere_courant++)          switch(*pointeur_caractere_courant++)
         {          {
Line 1294  recherche_instruction_suivante(struct_pr Line 1330  recherche_instruction_suivante(struct_pr
                 pointeur_caractere_courant++;                  pointeur_caractere_courant++;
   
                 if (((*pointeur_caractere_courant) != d_code_fin_chaine) &&                  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;                      erreur_analyse = d_ex_syntaxe;
                 }                  }
Line 1418  recherche_instruction_suivante(struct_pr Line 1455  recherche_instruction_suivante(struct_pr
                 }                  }
   
                 niveau = 1;                  niveau = 1;
                 niveau_annexe = 0;  
   
                 while((niveau != 0) && ((*pointeur_caractere_courant) !=                  while((niveau != 0) && ((*pointeur_caractere_courant) !=
                         d_code_fin_chaine))                          d_code_fin_chaine))
Line 1427  recherche_instruction_suivante(struct_pr Line 1463  recherche_instruction_suivante(struct_pr
                             pointeur_caractere_courant                              pointeur_caractere_courant
                             - (*s_etat_processus).definitions_chainees;                              - (*s_etat_processus).definitions_chainees;
   
                     if (recherche_instruction_suivante(s_etat_processus)                      registre_type_en_cours = (*s_etat_processus).type_en_cours;
                             == d_erreur)                      (*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                          if ((*s_etat_processus).instruction_courante
                                 != NULL)                                  != NULL)
                         {                          {
                             free((*s_etat_processus).instruction_courante);                              free((*s_etat_processus).instruction_courante);
                               (*s_etat_processus).instruction_courante = NULL;
                         }                          }
   
                         return(d_erreur);                          return(d_erreur);
                     }                      }
   
                       (*s_etat_processus).type_en_cours = registre_type_en_cours;
                     pointeur_caractere_courant =                      pointeur_caractere_courant =
                             (*s_etat_processus).definitions_chainees +                              (*s_etat_processus).definitions_chainees +
                             (*s_etat_processus).position_courante;                              (*s_etat_processus).position_courante;
   
                     if (strcmp((*s_etat_processus).instruction_courante, "{")                      if (strcmp((*s_etat_processus).instruction_courante, "}")
                             == 0)                              == 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--;                          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);                      free((*s_etat_processus).instruction_courante);
                 }                  }
   
                 if ((niveau != 0) || (niveau_annexe != 0))                  if (niveau != 0)
                 {                  {
                     erreur_analyse = d_ex_syntaxe;                      erreur_analyse = d_ex_syntaxe;
                 }                  }
Line 1626  recherche_instruction_suivante(struct_pr Line 1594  recherche_instruction_suivante(struct_pr
                         erreur_format = d_ex_syntaxe;                          erreur_format = d_ex_syntaxe;
                     }                      }
   
                     niveau = 1;                      pointeur_caractere_courant++;
                       drapeau_fin_objet = d_faux;
   
                     while((niveau != 0) && ((*pointeur_caractere_courant) !=                      while(((*pointeur_caractere_courant) != d_code_fin_chaine)
                             d_code_fin_chaine))                              && (erreur_format == d_absence_erreur))
                     {                      {
                         (*s_etat_processus).position_courante =                          while((*pointeur_caractere_courant) == d_code_espace)
                                 pointeur_caractere_courant                          {
                                 - (*s_etat_processus).definitions_chainees;                              pointeur_caractere_courant++;
                           }
   
                         if (recherche_instruction_suivante(s_etat_processus)                          if ((*pointeur_caractere_courant) == '>')
                                 == d_erreur)  
                         {                          {
                             if ((*s_etat_processus).instruction_courante                              if ((*(++pointeur_caractere_courant)) == '>')
                                     != NULL)                              {
                                   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 =                          if ((erreur_format == d_absence_erreur) &&
                                 (*s_etat_processus).definitions_chainees +                                  (drapeau_fin_objet == d_faux))
                                 (*s_etat_processus).position_courante;  
   
                         if (strcmp((*s_etat_processus).instruction_courante,  
                                 "<<") == 0)  
                         {  
                             niveau++;  
                         }  
                         else if (strcmp((*s_etat_processus)  
                                 .instruction_courante, ">>") == 0)  
                         {                          {
                             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;                          erreur_analyse = d_ex_syntaxe;
                           drapeau_fin_objet = d_vrai;
                     }                      }
   
                     drapeau_fin_objet = d_vrai;  
                 }                  }
                 else if ((*pointeur_caractere_courant) == '[')                  else if ((*pointeur_caractere_courant) == '[')
                 { // Cas <[ ]>                  { // Cas <[ ]>
Line 1713  recherche_instruction_suivante(struct_pr Line 1708  recherche_instruction_suivante(struct_pr
                                     pointeur_caractere_courant                                      pointeur_caractere_courant
                                     - (*s_etat_processus).definitions_chainees;                                      - (*s_etat_processus).definitions_chainees;
   
                             if ((erreur = recherche_instruction_suivante(                              registre_type_en_cours = (*s_etat_processus)
                                     s_etat_processus)) != d_absence_erreur)                                      .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                                  if ((*s_etat_processus).instruction_courante
                                         != NULL)                                          != NULL)
                                 {                                  {
                                     free((*s_etat_processus)                                      free((*s_etat_processus)
                                             .instruction_courante);                                              .instruction_courante);
                                       (*s_etat_processus).instruction_courante
                                               = NULL;
                                 }                                  }
   
                                 return(d_erreur);                                  return(d_erreur);
                             }                              }
   
                               (*s_etat_processus).type_en_cours =
                                       registre_type_en_cours;
                             pointeur_caractere_courant = (*s_etat_processus)                              pointeur_caractere_courant = (*s_etat_processus)
                                     .definitions_chainees + (*s_etat_processus)                                      .definitions_chainees + (*s_etat_processus)
                                     .position_courante;                                      .position_courante;
Line 1744  recherche_instruction_suivante(struct_pr Line 1752  recherche_instruction_suivante(struct_pr
                 break;                  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;      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 *)      (*s_etat_processus).instruction_courante = (unsigned char *)
                 malloc((((size_t) (pointeur_fin_instruction                  malloc((((size_t) (pointeur_fin_instruction
                 - pointeur_debut_instruction)) + 1) * sizeof(unsigned char));                  - pointeur_debut_instruction)) + 1) * sizeof(unsigned char));
Line 1788  recherche_instruction_suivante(struct_pr Line 1830  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      est nul, il s'est produit une erreur. L'allocation est faite dans la
     routine.      routine.
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------

Removed from v.1.65  
changed lines
  Added in v.1.71


CVSweb interface <joel.bertrand@systella.fr>