[BACK]Return to types.c CVS log [TXT] [DIR] Up to [local] / rpl / src

Diff for /rpl/src/types.c between versions 1.91 and 1.92

version 1.91, 2018/05/30 09:27:39 version 1.92, 2018/12/24 15:21:38
Line 78  recherche_type(struct_processus *s_etat_ Line 78  recherche_type(struct_processus *s_etat_
     logical1                    drapeau_valeur_reelle;      logical1                    drapeau_valeur_reelle;
     logical1                    erreur;      logical1                    erreur;
     logical1                    erreur_lecture_binaire;      logical1                    erreur_lecture_binaire;
       logical1                    tri_acheve;
   
     logical8                    ancienne_valeur_base;      logical8                    ancienne_valeur_base;
     logical8                    valeur_base;      logical8                    valeur_base;
Line 3313  recherche_type(struct_processus *s_etat_ Line 3314  recherche_type(struct_processus *s_etat_
                 }                  }
             }              }
   
               break;
           }
   
   /*
   --------------------------------------------------------------------------------
     Enregistrement
   --------------------------------------------------------------------------------
   */
   
           case '|' :
           {
               if ((*s_etat_processus).instruction_courante[1] == '[')
               {
                   (*s_etat_processus).type_en_cours = REC;
                   sauvegarde_longueur_definitions_chainees =
                           (*s_etat_processus).longueur_definitions_chainees;
   
                   tampon = (unsigned char *) malloc(((size_t)
                           (((*s_etat_processus).longueur_definitions_chainees
                           = (integer8) strlen((*s_etat_processus)
                           .instruction_courante) + 2) + 1)) *
                           sizeof(unsigned char));
   
                   if (tampon == NULL)
                   {
                       (*s_etat_processus).erreur_systeme =
                               d_es_allocation_memoire;
                       (*s_etat_processus).traitement_interruptible =
                               registre_interruption;
                       return;
                   }
   
                   strcpy(tampon, "<< ");
                   ptr_ecriture = tampon + 3;
                   ptr_lecture = (*s_etat_processus).instruction_courante + 2;
   
                   while((*ptr_lecture) != d_code_fin_chaine)
                   {
                       *ptr_ecriture++ = *ptr_lecture++;
                   }
   
                   ptr_ecriture -= 2;
                   (*ptr_ecriture) = d_code_fin_chaine;
                   strcat(ptr_ecriture, " >>");
   
                   position_courante = (*s_etat_processus).position_courante;
                   (*s_etat_processus).position_courante = 0;
   
                   profondeur_initiale = (*s_etat_processus)
                           .hauteur_pile_operationnelle;
   
   /*
   -- On met les éléments du tableau dans la pile opérationnelle ------------------
   */
   
                   (*s_etat_processus).niveau_recursivite++;
                   definitions_chainees_precedentes = (*s_etat_processus)
                           .definitions_chainees;
                   (*s_etat_processus).definitions_chainees = tampon;
   
                   s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
                   sauvegarde_niveau_courant = (*s_etat_processus).niveau_courant;
   
                   (*s_etat_processus).l_base_pile_systeme = NULL;
                   empilement_pile_systeme(s_etat_processus);
   
                   if ((*s_etat_processus).erreur_systeme != d_es)
                   {
                       (*s_etat_processus).traitement_interruptible =
                               registre_interruption;
                       return;
                   }
   
                   (*(*s_etat_processus).l_base_pile_systeme)
                           .retour_definition = 'Y';
                   (*(*s_etat_processus).l_base_pile_systeme)
                           .origine_routine_evaluation = 'N';
                   (*s_etat_processus).niveau_courant = 0;
                   (*s_etat_processus).autorisation_empilement_programme = 'N';
   
                   tampon = (*s_etat_processus).instruction_courante;
                   autorisation_evaluation_nom = (*s_etat_processus)
                           .autorisation_evaluation_nom;
                   (*s_etat_processus).autorisation_evaluation_nom = 'N';
   
                   registre_mode_execution_programme =
                           (*s_etat_processus).mode_execution_programme;
                   (*s_etat_processus).mode_execution_programme = 'Y';
                   (*s_etat_processus).erreur_scrutation = d_faux;
   
                   nombre_lignes_a_supprimer =
                           (*s_etat_processus).hauteur_pile_operationnelle;
   
                   if ((*s_etat_processus).profilage == d_vrai)
                   {
                       profilage(s_etat_processus, "RPL/2 internals");
   
                       if ((*s_etat_processus).erreur_systeme != d_es)
                       {
                           return;
                       }
                   }
   
                   registre_recherche_type = (*s_etat_processus).recherche_type;
                   (*s_etat_processus).recherche_type = 'Y';
   
                   variable_implicite =
                           (*s_etat_processus).autorisation_nom_implicite;
                   (*s_etat_processus).autorisation_nom_implicite = 'Y';
   
                   if (sequenceur(s_etat_processus) == d_erreur)
                   {
                       (*s_etat_processus).autorisation_nom_implicite =
                               variable_implicite;
                       (*s_etat_processus).erreur_execution = d_ex_syntaxe;
                       (*s_etat_processus).recherche_type =
                               registre_recherche_type;
                       (*s_etat_processus).mode_execution_programme =
                               registre_mode_execution_programme;
                       nombre_lignes_a_supprimer =
                               (*s_etat_processus).hauteur_pile_operationnelle
                               - nombre_lignes_a_supprimer;
   
                       for(i = 0; i < nombre_lignes_a_supprimer; i++)
                       {
                           if (depilement(s_etat_processus,
                                   &((*s_etat_processus).l_base_pile),
                                   &s_sous_objet) == d_erreur)
                           {
                               (*s_etat_processus).traitement_interruptible =
                                       registre_interruption;
                               return;
                           }
   
                           liberation(s_etat_processus, s_sous_objet);
                       }
   
                       (*s_etat_processus).instruction_courante = tampon;
                       (*s_etat_processus).autorisation_evaluation_nom =
                               autorisation_evaluation_nom;
   
                       effacement_pile_systeme(s_etat_processus);
                       (*s_etat_processus).l_base_pile_systeme =
                               s_sauvegarde_pile;
                       (*s_etat_processus).niveau_courant =
                               sauvegarde_niveau_courant;
   
                       free((*s_etat_processus).definitions_chainees);
                       (*s_etat_processus).niveau_recursivite--;
   
                       (*s_etat_processus).definitions_chainees =
                               definitions_chainees_precedentes;
                       (*s_etat_processus).longueur_definitions_chainees =
                               sauvegarde_longueur_definitions_chainees;
   
                       (*s_etat_processus).position_courante =
                               position_courante;
   
                       liberation(s_etat_processus, s_objet);
   
                       (*s_etat_processus).erreur_execution = d_ex_syntaxe;
                       (*s_etat_processus).traitement_interruptible =
                               registre_interruption;
                       return;
                   }
   
                   (*s_etat_processus).autorisation_nom_implicite =
                           variable_implicite;
                   (*s_etat_processus).recherche_type = registre_recherche_type;
                   (*s_etat_processus).mode_execution_programme =
                           registre_mode_execution_programme;
   
                   if ((*s_etat_processus).erreur_scrutation == d_vrai)
                   {
                       nombre_lignes_a_supprimer =
                               (*s_etat_processus).hauteur_pile_operationnelle
                               - nombre_lignes_a_supprimer;
   
                       for(i = 0; i < nombre_lignes_a_supprimer; i++)
                       {
                           if (depilement(s_etat_processus,
                                   &((*s_etat_processus).l_base_pile),
                                   &s_sous_objet) == d_erreur)
                           {
                               (*s_etat_processus).traitement_interruptible =
                                       registre_interruption;
                               return;
                           }
   
                           liberation(s_etat_processus, s_sous_objet);
                       }
   
                       (*s_etat_processus).instruction_courante = tampon;
                       (*s_etat_processus).autorisation_evaluation_nom =
                               autorisation_evaluation_nom;
   
                       effacement_pile_systeme(s_etat_processus);
                       (*s_etat_processus).l_base_pile_systeme =
                               s_sauvegarde_pile;
                       (*s_etat_processus).niveau_courant =
                               sauvegarde_niveau_courant;
   
                       free((*s_etat_processus).definitions_chainees);
                       (*s_etat_processus).niveau_recursivite--;
   
                       (*s_etat_processus).definitions_chainees =
                               definitions_chainees_precedentes;
                       (*s_etat_processus).longueur_definitions_chainees =
                               sauvegarde_longueur_definitions_chainees;
   
                       (*s_etat_processus).position_courante =
                               position_courante;
   
                       liberation(s_etat_processus, s_objet);
   
                       (*s_etat_processus).erreur_execution = d_ex_syntaxe;
                       (*s_etat_processus).traitement_interruptible =
                               registre_interruption;
                       return;
                   }
   
                   (*s_etat_processus).instruction_courante = tampon;
                   (*s_etat_processus).autorisation_evaluation_nom =
                           autorisation_evaluation_nom;
   
                   (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
                   (*s_etat_processus).niveau_courant =
                           sauvegarde_niveau_courant;
   
                   free((*s_etat_processus).definitions_chainees);
                   (*s_etat_processus).definitions_chainees =
                           definitions_chainees_precedentes;
                   (*s_etat_processus).longueur_definitions_chainees =
                           sauvegarde_longueur_definitions_chainees;
   
                   (*s_etat_processus).niveau_recursivite--;
   
                   (*s_etat_processus).position_courante = position_courante;
   
   /*
   -- On relit la pile qui contient des sous-objets contenant les -----------------
   -- éléments du tableau ---------------------------------------------------------
   */
   
                   profondeur_finale = (*s_etat_processus)
                           .hauteur_pile_operationnelle;
   
                   nombre_lignes = profondeur_finale - profondeur_initiale;
   
                   // Il ne peut y avoir que deux lignes.
   
                   if (nombre_lignes != 2)
                   {
                       (*s_etat_processus).traitement_interruptible =
                               registre_interruption;
                       (*s_etat_processus).erreur_execution =
                               d_ex_dimensions_invalides;
                       return;
                   }
   
                   if ((element = malloc(sizeof(struct_record))) == NULL)
                   {
                       (*s_etat_processus).erreur_systeme =
                               d_es_allocation_memoire;
                       (*s_etat_processus).traitement_interruptible =
                               registre_interruption;
                       return;
                   }
   
                   if (depilement(s_etat_processus,
                           &((*s_etat_processus).l_base_pile),
                           &((*((struct_record *) element)).donnees))
                           == d_erreur)
                   {
                       (*s_etat_processus).traitement_interruptible =
                               registre_interruption;
                       return;
                   }
   
                   if (depilement(s_etat_processus,
                           &((*s_etat_processus).l_base_pile),
                           &((*((struct_record *) element)).noms))
                           == d_erreur)
                   {
                       (*s_etat_processus).traitement_interruptible =
                               registre_interruption;
                       return;
                   }
   
                   (*s_objet).type = REC;
                   (*s_etat_processus).traitement_interruptible =
                           registre_interruption;
   
                   // Vérification des types.
   
                   if (((*(*((struct_record *) element)).donnees).type != TBL)
                           || ((*(*((struct_record *) element)).noms).type != TBL))
                   {
                       (*s_objet).objet = element;
                       liberation(s_etat_processus, s_objet);
   
                       (*s_etat_processus).erreur_execution =
                               d_ex_erreur_type_argument;
                       return;
                   }
   
                   for(i = 0; i < (*((struct_tableau *) (*(*((struct_record *)
                           element)).noms).objet)).nombre_elements; i++)
                   {
                       if ((*(*((struct_tableau *) (*(*((struct_record *) element))
                               .noms).objet)).elements[i]).type != CHN)
                       {
                           (*s_objet).objet = element;
                           liberation(s_etat_processus, s_objet);
   
                           (*s_etat_processus).erreur_execution =
                                   d_ex_erreur_type_argument;
                           return;
                       }
                   }
   
                   // Vérification des dimensions
   
                   if ((*((struct_tableau *) (*(*((struct_record *) element))
                           .donnees).objet)).nombre_elements !=
                           (*((struct_tableau *) (*(*((struct_record *) element))
                           .noms).objet)).nombre_elements)
                   {
                       (*s_objet).objet = element;
                       liberation(s_etat_processus, s_objet);
   
                       (*s_etat_processus).erreur_execution =
                               d_ex_dimensions_invalides;
                       return;
                   }
   
                   // Tri de l'enregistrement (tri bull)
   
                   tri_acheve = d_faux;
   
                   while(tri_acheve == d_faux)
                   {
                       tri_acheve = d_vrai;
   
                       for(i = 0; i < (*((struct_tableau *) (*(*((struct_record *)
                               element)).noms).objet)).nombre_elements - 1; i++)
                       {
                           if (strcmp((unsigned char *) (*(*((struct_tableau *)
                                   (*(*((struct_record *) element)).noms).objet))
                                   .elements[i]).objet, (unsigned char *)
                                   (*(*((struct_tableau *) (*(*((struct_record *)
                                   element)).noms).objet)).elements[i + 1]).objet)
                                   > 0)
                           {
                               tri_acheve = d_faux;
   
                               tampon = (unsigned char *) (*(*((struct_tableau *)
                                       (*(*((struct_record *) element)).noms)
                                       .objet)).elements[i + 1]).objet;
                               (*(*((struct_tableau *) (*(*((struct_record *)
                                       element)).noms).objet)).elements[i + 1])
                                       .objet = (*(*((struct_tableau *)
                                       (*(*((struct_record *) element)).noms)
                                       .objet)).elements[i]).objet;
                               (*(*((struct_tableau *) (*(*((struct_record *)
                                       element)).noms).objet)).elements[i]).objet =
                                       tampon;
   
                               s_objet_registre = (*((struct_tableau *)
                                       (*(*((struct_record *) element)).donnees)
                                       .objet)).elements[i + 1];
                               (*((struct_tableau *) (*(*((struct_record *)
                                       element)).donnees).objet)).elements[i + 1] =
                                       (*((struct_tableau *) (*(*((struct_record *)
                                       element)).donnees).objet)).elements[i];
                               (*((struct_tableau *) (*(*((struct_record *)
                                       element)).donnees).objet)).elements[i] =
                                       s_objet_registre;
                           }
                       }
                   }
   
                   // Vérification de l'unicité des noms
   
                   for(i = 0; i < (*((struct_tableau *) (*(*((struct_record *)
                               element)).noms).objet)).nombre_elements - 1; i++)
                   {
                       if (strcmp((unsigned char *) (*(*((struct_tableau *)
                               (*(*((struct_record *) element)).noms).objet))
                               .elements[i]).objet, (unsigned char *)
                               (*(*((struct_tableau *) (*(*((struct_record *)
                               element)).noms).objet)) .elements[i + 1]).objet)
                               == 0)
                       {
                           (*s_objet).objet = element;
                           liberation(s_etat_processus, s_objet);
   
                           (*s_etat_processus).erreur_execution =
                                   d_ex_argument_invalide;
                           return;
                       }
                   }
               }
   
             break;              break;
         }          }
   
Removed from v.1.91  
changed lines
  Added in v.1.92

CVSweb interface <joel.bertrand@systella.fr>