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

Diff for /rpl/src/types.c between versions 1.73 and 1.101

version 1.73, 2015/02/19 11:01:30 version 1.101, 2024/01/09 07:33:56
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.1.21    RPL/2 (R) version 4.1.35
   Copyright (C) 1989-2015 Dr. BERTRAND Joël    Copyright (C) 1989-2024 Dr. BERTRAND Joël
   
   This file is part of RPL/2.    This file is part of RPL/2.
   
Line 56  recherche_type(struct_processus *s_etat_ Line 56  recherche_type(struct_processus *s_etat_
     integer8                    profondeur_initiale;      integer8                    profondeur_initiale;
     integer8                    sauvegarde_niveau_courant;      integer8                    sauvegarde_niveau_courant;
     integer8                    sauvegarde_longueur_definitions_chainees;      integer8                    sauvegarde_longueur_definitions_chainees;
       integer8                    (*__type_new)(struct_processus *, void **);
   
     struct_liste_chainee        *l_base_liste_fonctions;      struct_liste_chainee        *l_base_liste_fonctions;
     struct_liste_chainee        *l_base_liste_decomposition;      struct_liste_chainee        *l_base_liste_decomposition;
Line 77  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 260  recherche_type(struct_processus *s_etat_ Line 262  recherche_type(struct_processus *s_etat_
   
     (*s_etat_processus).instruction_valide = registre_instruction_valide;      (*s_etat_processus).instruction_valide = registre_instruction_valide;
   
   /*
   --------------------------------------------------------------------------------
     Types externes
   --------------------------------------------------------------------------------
   */
   
       l_element_courant = (*s_etat_processus).s_bibliotheques;
   
       while(l_element_courant != NULL)
       {
           if ((__type_new = dlsym((*((struct_bibliotheque *)
                   (*l_element_courant).donnee)).descripteur, "__type_new"))
                   != NULL)
           {
               if (((*s_objet).extension_type = __type_new(s_etat_processus,
                       &element)) != 0)
               {
                   // Le type peut être converti.
   
                   (*s_objet).objet = element;
                   (*s_objet).type = EXT;
                   (*s_objet).descripteur_bibliotheque =
                           (*((struct_bibliotheque *)
                           (*l_element_courant).donnee)).descripteur;
   
                   if (empilement(s_etat_processus,
                           &((*s_etat_processus).l_base_pile), s_objet)
                           == d_erreur)
                   {
                       (*s_etat_processus).erreur_systeme =
                               d_es_allocation_memoire;
                       (*s_etat_processus).traitement_interruptible =
                               registre_interruption;
                       return;
                   }
   
                   (*s_etat_processus).traitement_interruptible =
                           registre_interruption;
                   return;
               }
           }
   
           l_element_courant = (*l_element_courant).suivant;
       }
   
   /*
   --------------------------------------------------------------------------------
     Types internes
   --------------------------------------------------------------------------------
   */
   
     switch(*((*s_etat_processus).instruction_courante))      switch(*((*s_etat_processus).instruction_courante))
     {      {
   
Line 2980  recherche_type(struct_processus *s_etat_ Line 3033  recherche_type(struct_processus *s_etat_
   
                 (*(*s_etat_processus).l_base_pile_systeme)                  (*(*s_etat_processus).l_base_pile_systeme)
                         .retour_definition = 'Y';                          .retour_definition = 'Y';
                   (*(*s_etat_processus).l_base_pile_systeme)
                           .origine_routine_evaluation = 'N';
                 (*s_etat_processus).niveau_courant = 0;                  (*s_etat_processus).niveau_courant = 0;
                 (*s_etat_processus).autorisation_empilement_programme = 'N';                  (*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 =                  registre_mode_execution_programme =
                         (*s_etat_processus).mode_execution_programme;                          (*s_etat_processus).mode_execution_programme;
                 (*s_etat_processus).mode_execution_programme = 'Y';                  (*s_etat_processus).mode_execution_programme = 'Y';
                 (*s_etat_processus).erreur_scrutation = d_faux;                  (*s_etat_processus).erreur_scrutation = d_faux;
   
                 tampon = (*s_etat_processus).instruction_courante;  
                 nombre_lignes_a_supprimer =                  nombre_lignes_a_supprimer =
                         (*s_etat_processus).hauteur_pile_operationnelle;                          (*s_etat_processus).hauteur_pile_operationnelle;
   
Line 3036  recherche_type(struct_processus *s_etat_ Line 3096  recherche_type(struct_processus *s_etat_
                     }                      }
   
                     (*s_etat_processus).instruction_courante = tampon;                      (*s_etat_processus).instruction_courante = tampon;
                       (*s_etat_processus).autorisation_evaluation_nom =
                               autorisation_evaluation_nom;
   
                     effacement_pile_systeme(s_etat_processus);                      effacement_pile_systeme(s_etat_processus);
                     (*s_etat_processus).l_base_pile_systeme =                      (*s_etat_processus).l_base_pile_systeme =
Line 3089  recherche_type(struct_processus *s_etat_ Line 3151  recherche_type(struct_processus *s_etat_
                     }                      }
   
                     (*s_etat_processus).instruction_courante = tampon;                      (*s_etat_processus).instruction_courante = tampon;
                       (*s_etat_processus).autorisation_evaluation_nom =
                               autorisation_evaluation_nom;
   
                     effacement_pile_systeme(s_etat_processus);                      effacement_pile_systeme(s_etat_processus);
                     (*s_etat_processus).l_base_pile_systeme =                      (*s_etat_processus).l_base_pile_systeme =
Line 3116  recherche_type(struct_processus *s_etat_ Line 3180  recherche_type(struct_processus *s_etat_
                 }                  }
   
                 (*s_etat_processus).instruction_courante = tampon;                  (*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).l_base_pile_systeme = s_sauvegarde_pile;
                 (*s_etat_processus).niveau_courant =                  (*s_etat_processus).niveau_courant =
Line 3253  recherche_type(struct_processus *s_etat_ Line 3319  recherche_type(struct_processus *s_etat_
   
 /*  /*
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
     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;
           }
   
   /*
   --------------------------------------------------------------------------------
   Entier ou réel    Entier ou réel
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
 */  */
Line 3477  recherche_type(struct_processus *s_etat_ Line 3947  recherche_type(struct_processus *s_etat_
   
                 while((*ptr) != d_code_fin_chaine)                  while((*ptr) != d_code_fin_chaine)
                 {                  {
                     if ((isalnum((*ptr)) == 0) &&                      if (isalnum(*ptr) != 0)
                             ((*ptr) != '_') &&                      {
                             ((*ptr) != '$'))                          ptr++;
                       }
                       else if (((*ptr) == '_') || ((*ptr == '$')))
                       {
                           ptr++;
                       }
                       else
                     {                      {
                         liberation(s_etat_processus, s_objet);                          liberation(s_etat_processus, s_objet);
   
                         (*s_etat_processus).erreur_execution = d_ex_syntaxe;                          (*s_etat_processus).erreur_execution = d_ex_syntaxe;
                         (*s_etat_processus).traitement_interruptible =                          (*s_etat_processus).traitement_interruptible =
                                 registre_interruption;                                  registre_interruption;
   
                         return;                          return;
                     }                      }
   
                     ptr++;  
                 }                  }
   
                 (*s_objet).type = NOM;                  (*s_objet).type = NOM;
Removed from v.1.73  
changed lines
  Added in v.1.101

CVSweb interface <joel.bertrand@systella.fr>