[BACK]Return to interface_cas.cpp CVS log [TXT] [DIR] Up to [local] / rpl / src

Diff for /rpl/src/interface_cas.cpp between versions 1.4 and 1.55

version 1.4, 2011/06/24 15:59:07 version 1.55, 2017/08/03 17:17:49
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.1.0.prerelease.3    RPL/2 (R) version 4.1.28
   Copyright (C) 1989-2011 Dr. BERTRAND Joël    Copyright (C) 1989-2017 Dr. BERTRAND Joël
   
   This file is part of RPL/2.    This file is part of RPL/2.
   
Line 20 Line 20
 */  */
   
   
 #include "giac.h"  #ifdef RPLCAS
   
 #undef PACKAGE  // Giac inclut <semaphore.h> et définit sem_t. Or l'émulation
 #undef PACKAGE_NAME  // des IPCS POSIX requiert une redéfinition de sem_t.
 #undef PACKAGE_STRING  
 #undef PACKAGE_TARNAME  #   ifdef IPCS_SYSV
 #undef PACKAGE_VERSION  //      NetBSD : _SEMAPHORE_H_
 #undef VERSION  #       define _SEMAPHORE_H_
   //      Linux : _SEMAPHORE_H
   #       define _SEMAPHORE_H
   #   endif
   
   #   pragma GCC diagnostic push
   #   pragma GCC diagnostic ignored "-Wstrict-aliasing"
   #   pragma GCC diagnostic ignored "-Wunused-parameter"
   #   pragma GCC diagnostic ignored "-Wempty-body"
   #   pragma GCC diagnostic ignored "-Wunknown-pragmas"
   #   include "giac.h"
   #   pragma GCC diagnostic pop
   
   #   undef PACKAGE
   #   undef PACKAGE_NAME
   #   undef PACKAGE_STRING
   #   undef PACKAGE_TARNAME
   #   undef PACKAGE_VERSION
   #   undef VERSION
   #endif
   
 extern "C"  extern "C"
 {  {
Line 38  extern "C" Line 57  extern "C"
 #include <iostream>  #include <iostream>
   
 using namespace std;  using namespace std;
 using namespace giac;  
   
   #ifdef RPLCAS
       using namespace giac;
   #endif
   
   void
   initialisation_contexte_cas(struct_processus *s_etat_processus)
   {
       s_etat_processus->contexte_cas = NULL;
       return;
   }
   
   void
   liberation_contexte_cas(struct_processus *s_etat_processus)
   {
       if (s_etat_processus->contexte_cas != NULL)
       {
   #       ifdef RPLCAS
           delete reinterpret_cast<giac::context *>(
                   s_etat_processus->contexte_cas);
   #       endif
           s_etat_processus->contexte_cas = NULL;
       }
   
       return;
   }
   
   #ifdef RPLCAS
 static unsigned char *  static unsigned char *
 conversion_rpl_vers_cas(struct_processus *s_etat_processus,  conversion_rpl_vers_cas(struct_processus *s_etat_processus,
         struct_objet **s_objet)          struct_objet **s_objet)
 {  {
       logical1                drapeau;
   
     struct_liste_chainee    *l_element_courant;      struct_liste_chainee    *l_element_courant;
   
     struct_objet            *s_objet_temporaire;      struct_objet            *s_objet_temporaire;
Line 52  conversion_rpl_vers_cas(struct_processus Line 98  conversion_rpl_vers_cas(struct_processus
     t_8_bits                registre[8];      t_8_bits                registre[8];
   
     unsigned char           *resultat;      unsigned char           *resultat;
       unsigned char           *index;
   
     for(int i = 0; i < 8; i++)      for(int i = 0; i < 8; i++)
     {      {
         registre[i] = s_etat_processus->drapeaux_etat[i];          registre[i] = s_etat_processus->drapeaux_etat[i];
     }      }
   
       sf(s_etat_processus, 35);
     cf(s_etat_processus, 48);      cf(s_etat_processus, 48);
     cf(s_etat_processus, 49);      cf(s_etat_processus, 49);
     cf(s_etat_processus, 50);      cf(s_etat_processus, 50);
Line 71  conversion_rpl_vers_cas(struct_processus Line 119  conversion_rpl_vers_cas(struct_processus
     // les noms de fonction. Les fonctions ne peuvent apparaître que dans le      // les noms de fonction. Les fonctions ne peuvent apparaître que dans le
     // cas d'un objet de type ALG.      // cas d'un objet de type ALG.
   
     if ((*s_objet)->type == ALG)      if ((*s_objet)->type == NOM)
     {      {
         if ((*s_objet)->nombre_occurrences > 1)          if (strcmp((const char *) reinterpret_cast<unsigned char *>(
                   reinterpret_cast<struct_nom *>((*s_objet)->objet)->nom),
                   "infinity") == 0)
         {          {
             if ((s_objet_temporaire = copie_objet(s_etat_processus,              if (evaluation(s_etat_processus, *s_objet, 'N') == d_erreur)
                     (*s_objet), 'O')) == NULL)  
             {              {
                 s_etat_processus->erreur_systeme = d_es_allocation_memoire;  
                 return(NULL);                  return(NULL);
             }              }
   
             liberation(s_etat_processus, (*s_objet));              liberation(s_etat_processus, *s_objet);
             (*s_objet) = s_objet_temporaire;  
               if (depilement(s_etat_processus, &(s_etat_processus
                       ->l_base_pile), s_objet) == d_erreur)
               {
                   return(NULL);
               }
         }          }
       }
       else if ((*s_objet)->type == ALG)
       {
           if ((s_objet_temporaire = copie_objet(s_etat_processus,
                   (*s_objet), 'O')) == NULL)
           {
               s_etat_processus->erreur_systeme = d_es_allocation_memoire;
               return(NULL);
           }
   
           liberation(s_etat_processus, (*s_objet));
           (*s_objet) = s_objet_temporaire;
   
           // Si l'expression contient la fonction infinity, on commence par
           // forcer une évaluation numérique.
   
           l_element_courant = reinterpret_cast<struct_liste_chainee *>(
                   (*s_objet)->objet);
           drapeau = d_faux;
   
           while(l_element_courant != NULL)
           {
               if (l_element_courant->donnee->type == NOM)
               {
                   if (strcmp((const char *) reinterpret_cast<unsigned char *>(
                           reinterpret_cast<struct_nom *>(
                           l_element_courant->donnee->objet)->nom),
                           "infinity") == 0)
                   {
                       drapeau = d_vrai;
                       break;
                   }
               }
   
               l_element_courant = l_element_courant->suivant;
           }
   
           if (drapeau == d_vrai)
           {
               if (evaluation(s_etat_processus, *s_objet, 'N') == d_erreur)
               {
                   return(NULL);
               }
   
               liberation(s_etat_processus, *s_objet);
   
               if (depilement(s_etat_processus, &(s_etat_processus
                       ->l_base_pile), s_objet) == d_erreur)
               {
                   return(NULL);
               }
           }
       }
   
       if ((*s_objet)->type == ALG)
       {
   
         l_element_courant = reinterpret_cast<struct_liste_chainee *>(          l_element_courant = reinterpret_cast<struct_liste_chainee *>(
                 (*s_objet)->objet);                  (*s_objet)->objet);
Line 95  conversion_rpl_vers_cas(struct_processus Line 204  conversion_rpl_vers_cas(struct_processus
             {              {
                 unsigned char       *ptr;                  unsigned char       *ptr;
   
                 ptr = reinterpret_cast<unsigned char *>(((struct_fonction *)                  ptr = reinterpret_cast<unsigned char *>(
                           reinterpret_cast<struct_fonction *>(
                         l_element_courant->donnee->objet)->nom_fonction);                          l_element_courant->donnee->objet)->nom_fonction);
   
                 while((*ptr) != d_code_fin_chaine)                  while((*ptr) != d_code_fin_chaine)
Line 117  conversion_rpl_vers_cas(struct_processus Line 227  conversion_rpl_vers_cas(struct_processus
     }      }
   
     resultat = formateur(s_etat_processus, 0, (*s_objet));      resultat = formateur(s_etat_processus, 0, (*s_objet));
     resultat[0] = ' ';  
     resultat[strlen((const char *) resultat) - 1] = ' ';      // Il faut remplacer les occurrences de 'relax' par '    +'.
   
       index = resultat;
       while((index = reinterpret_cast<unsigned char *>(
               strstr(reinterpret_cast<char *>(index),
               (const char *) "relax"))) != NULL)
       {
           strncpy(reinterpret_cast<char *>(index), "    +", 5);
       }
   
       // Si le résultat vaut infinity, on rajoute le signe +.
   
       if (strcmp(reinterpret_cast<char *>(resultat), "infinity") == 0)
       {
           if ((resultat = reinterpret_cast<unsigned char *>(
                   realloc(resultat, (strlen(reinterpret_cast<char *>(
                   resultat)) + 2) * sizeof(unsigned char)))) == NULL)
           {
               s_etat_processus->erreur_systeme = d_es_allocation_memoire;
               return(NULL);
           }
   
           strcpy(reinterpret_cast<char *>(resultat), "+infinity");
       }
   
       if (resultat[0] == '\'')
       {
           resultat[0] = ' ';
           resultat[strlen((const char *) resultat) - 1] = ' ';
       }
   
     for(int i = 0; i < 8; i++)      for(int i = 0; i < 8; i++)
     {      {
Line 131  conversion_rpl_vers_cas(struct_processus Line 270  conversion_rpl_vers_cas(struct_processus
   
 static void  static void
 conversion_cas_vers_rpl(struct_processus *s_etat_processus,  conversion_cas_vers_rpl(struct_processus *s_etat_processus,
         struct_objet *s_objet)          unsigned char *expression)
 {  {
       logical1                    drapeau;
   
     struct_liste_chainee        *l_element_courant;      struct_liste_chainee        *l_element_courant;
     struct_liste_chainee        *l_element_precedent;  
       struct_objet                *s_objet;
   
       unsigned char               *registre;
   
       registre = s_etat_processus->instruction_courante;
       s_etat_processus->instruction_courante = expression;
       recherche_type(s_etat_processus);
       s_etat_processus->instruction_courante = registre;
   
       if ((s_etat_processus->l_base_pile == NULL) ||
               (s_etat_processus->erreur_execution != d_ex) ||
               (s_etat_processus->erreur_systeme != d_es))
       {
           return;
       }
   
       // Le niveau 1 de la pile opérationnelle contient l'expression
       // à convertir.
   
       if (depilement(s_etat_processus, &(s_etat_processus
               ->l_base_pile), &s_objet) == d_erreur)
       {
           return;
       }
   
     if ((s_objet->type == ALG) || (s_objet->type == RPN))      if ((s_objet->type == ALG) || (s_objet->type == RPN))
     {      {
         // On transcrit les fonctions de GIAC vers le RPL/2.          // On transcrit les fonctions de GIAC vers le RPL/2.
   
         l_element_precedent = NULL;          l_element_courant = reinterpret_cast<struct_liste_chainee *>(
                   s_objet->objet);
           drapeau = d_faux;
   
           // S'il y a une valeur infini, on force l'évaluation de l'expression.
   
           while(l_element_courant != NULL)
           {
               if (l_element_courant->donnee->type == NOM)
               {
                   if (strcmp((const char *) reinterpret_cast<unsigned char *>(
                           reinterpret_cast<struct_nom *>(
                           l_element_courant->donnee->objet)->nom),
                           "infinity") == 0)
                   {
                       drapeau = d_vrai;
                       break;
                   }
               }
   
               l_element_courant = l_element_courant->suivant;
           }
   
           if (drapeau == d_vrai)
           {
               if (evaluation(s_etat_processus, s_objet, 'N') == d_erreur)
               {
                   return;
               }
   
               liberation(s_etat_processus, s_objet);
   
               if (depilement(s_etat_processus, &(s_etat_processus
                       ->l_base_pile), &s_objet) == d_erreur)
               {
                   return;
               }
           }
       }
   
       if ((s_objet->type == ALG) || (s_objet->type == RPN))
       {
         l_element_courant = reinterpret_cast<struct_liste_chainee *>(          l_element_courant = reinterpret_cast<struct_liste_chainee *>(
                 s_objet->objet);                  s_objet->objet);
   
Line 152  conversion_cas_vers_rpl(struct_processus Line 358  conversion_cas_vers_rpl(struct_processus
                 // qui n'est pas reconnu comme un mot-clef du RPL/2. S'il                  // qui n'est pas reconnu comme un mot-clef du RPL/2. S'il
                 // s'agit d'un mot-clef de GIAC, on le convertit.                  // s'agit d'un mot-clef de GIAC, on le convertit.
   
                 if (strcmp(const_cast<const char *>(reinterpret_cast<char *>(                  if ((strcmp((const char *)
                         ((struct_fonction *) l_element_courant->donnee                          reinterpret_cast<struct_fonction *>(l_element_courant
                         ->objet)->nom_fonction)), "quote") == 0)                          ->donnee->objet)->nom_fonction, "quote") == 0) ||
                           (strcmp((const char *)
                           reinterpret_cast<struct_fonction *>(l_element_courant
                           ->donnee->objet)->nom_fonction, "nop") == 0))
                 {                  {
                     liberation(s_etat_processus, l_element_courant->donnee);                      liberation(s_etat_processus, l_element_courant->donnee);
   
Line 176  conversion_cas_vers_rpl(struct_processus Line 385  conversion_cas_vers_rpl(struct_processus
                         return;                          return;
                     }                      }
   
                     strcpy(reinterpret_cast<char *>(((struct_fonction *)                      strcpy(reinterpret_cast<char *>(
                               reinterpret_cast<struct_fonction *>(
                             l_element_courant->donnee->objet)->nom_fonction),                              l_element_courant->donnee->objet)->nom_fonction),
                             "RELAX");                              "RELAX");
                 }                  }
             }              }
   
             l_element_precedent = l_element_courant;  
             l_element_courant = l_element_courant->suivant;              l_element_courant = l_element_courant->suivant;
         }          }
     }      }
   
       if (empilement(s_etat_processus, &(s_etat_processus->l_base_pile),
               s_objet) == d_erreur)
       {
           return;
       }
   
     return;      return;
 }  }
   #endif
   
   
 /*  /*
Line 204  conversion_cas_vers_rpl(struct_processus Line 420  conversion_cas_vers_rpl(struct_processus
 ================================================================================  ================================================================================
 */  */
   
   #pragma GCC diagnostic push
   #pragma GCC diagnostic ignored "-Wunused-parameter"
 void  void
 interface_cas(struct_processus *s_etat_processus,  interface_cas(struct_processus *s_etat_processus,
         enum t_rplcas_commandes commande)          enum t_rplcas_commandes commande)
 {  {
   #ifdef RPLCAS
     struct_objet            *s_objet_argument_1;      struct_objet            *s_objet_argument_1;
     struct_objet            *s_objet_argument_2;      struct_objet            *s_objet_argument_2;
       struct_objet            *s_objet_temporaire;
   
       struct_liste_chainee    *l_element_courant;
   
     unsigned char           *argument_1;      unsigned char           *argument_1;
     unsigned char           *argument_2;      unsigned char           *argument_2;
     unsigned char           *registre;      unsigned char           *argument_3;
       unsigned char           *argument_4;
   
       unsigned int            position;
   
       giac::context           *contexte;
   
       if (s_etat_processus->contexte_cas == NULL)
       {
           try
           {
               s_etat_processus->contexte_cas = new giac::context;
           }
           catch(bad_alloc exception)
           {
               s_etat_processus->erreur_systeme = d_es_allocation_memoire;
               return;
           }
           catch(...)
           {
               s_etat_processus->erreur_execution = d_ex_erreur_interne_rplcas;
               return;
           }
       }
   
       contexte = reinterpret_cast<giac::context *>(
               s_etat_processus->contexte_cas);
   
       if ((s_etat_processus->erreur_execution != d_ex) ||
               (s_etat_processus->erreur_systeme != d_es))
       {
           return;
       }
   
     switch(commande)      switch(commande)
     {      {
Line 222  interface_cas(struct_processus *s_etat_p Line 476  interface_cas(struct_processus *s_etat_p
             if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),              if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
                     &s_objet_argument_1) == d_erreur)                      &s_objet_argument_1) == d_erreur)
             {              {
                 (*s_etat_processus).erreur_execution = d_ex_manque_argument;                  s_etat_processus->erreur_execution = d_ex_manque_argument;
                 return;                  return;
             }              }
   
Line 230  interface_cas(struct_processus *s_etat_p Line 484  interface_cas(struct_processus *s_etat_p
                     &s_objet_argument_2) == d_erreur)                      &s_objet_argument_2) == d_erreur)
             {              {
                 liberation(s_etat_processus, s_objet_argument_1);                  liberation(s_etat_processus, s_objet_argument_1);
                 (*s_etat_processus).erreur_execution = d_ex_manque_argument;                  s_etat_processus->erreur_execution = d_ex_manque_argument;
                 return;                  return;
             }              }
   
Line 251  interface_cas(struct_processus *s_etat_p Line 505  interface_cas(struct_processus *s_etat_p
             liberation(s_etat_processus, s_objet_argument_1);              liberation(s_etat_processus, s_objet_argument_1);
             liberation(s_etat_processus, s_objet_argument_2);              liberation(s_etat_processus, s_objet_argument_2);
   
             gen variable(string(reinterpret_cast<const char *>(argument_1)),              try
                     giac::context0);              {
             gen expression(string(reinterpret_cast<const char *>(argument_2)),                  gen variable(
                     giac::context0);                          string(reinterpret_cast<const char *>(argument_1)),
                           contexte);
                   gen expression(
                           string(reinterpret_cast<const char *>(argument_2)),
                           contexte);
   
                   gen resultat = integrate_gen(expression, variable,
                           contexte);
                   string chaine = "'" + resultat.print() + "'";
   
                   conversion_cas_vers_rpl(s_etat_processus,
                           reinterpret_cast<unsigned char *>(const_cast<char *>(
                           chaine.c_str())));
               }
               catch(bad_alloc exception)
               {
                   s_etat_processus->erreur_systeme = d_es_allocation_memoire;
               }
               catch(...)
               {
                   s_etat_processus->erreur_execution = d_ex_erreur_interne_rplcas;
               }
   
             free(argument_1);              free(argument_1);
             free(argument_2);              free(argument_2);
   
             gen resultat = integrate(expression, variable, giac::context0);              break;
             string chaine = "'" + resultat.print() + "'";          }
   
           case RPLCAS_LIMITE:
           {
               if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
                       &s_objet_argument_1) == d_erreur)
               {
                   s_etat_processus->erreur_execution = d_ex_manque_argument;
                   return;
               }
   
               if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
                       &s_objet_argument_2) == d_erreur)
               {
                   liberation(s_etat_processus, s_objet_argument_1);
                   s_etat_processus->erreur_execution = d_ex_manque_argument;
                   return;
               }
   
               // Fonction
   
               if ((argument_2 = conversion_rpl_vers_cas(s_etat_processus,
                       &s_objet_argument_2)) == NULL)
               {
                   s_etat_processus->erreur_systeme = d_es_allocation_memoire;
                   return;
               }
   
               // On parcourt la liste. Cette liste est tout d'abord copiée
               // car on est susceptible de modifier le second élément.
   
               if ((s_objet_temporaire = copie_objet(s_etat_processus,
                       s_objet_argument_1, 'O')) == NULL)
               {
                   s_etat_processus->erreur_systeme = d_es_allocation_memoire;
                   return;
               }
   
               liberation(s_etat_processus, s_objet_argument_1);
               s_objet_argument_1 = s_objet_temporaire;
   
               l_element_courant = reinterpret_cast<struct_liste_chainee *>
                       (s_objet_argument_1->objet);
               position = 1;
               argument_1 = NULL;
               argument_3 = NULL;
               argument_4 = NULL;
   
               while(l_element_courant != NULL)
               {
                   switch(position)
                   {
                       case 1:
                       {
                           // Variable
   
                           if ((argument_1 = reinterpret_cast<unsigned char *>
                                   (malloc((strlen((const char *)
                                   ((struct_variable *) (l_element_courant
                                   ->donnee->objet))->nom)
                                   + 1) * sizeof(unsigned char)))) == NULL)
                           {
                               s_etat_processus->erreur_systeme =
                                       d_es_allocation_memoire;
                               return;
                           }
   
                           strcpy(reinterpret_cast<char *>(argument_1),
                                   (const char *) ((struct_variable *)
                                   (l_element_courant->donnee->objet))->nom);
                           break;
                       }
   
             registre = s_etat_processus->instruction_courante;                      case 2:
             s_etat_processus->instruction_courante =                      {
                     reinterpret_cast<unsigned char*>(const_cast<char *>                          // Valeur
                     (chaine.c_str()));                          if ((argument_3 = conversion_rpl_vers_cas(
                                   s_etat_processus,
                                   &(l_element_courant->donnee))) == NULL)
                           {
                               s_etat_processus->erreur_systeme =
                                       d_es_allocation_memoire;
                               return;
                           }
   
                           break;
                       }
   
                       case 3:
                       {
                           // Direction
   
                           if ((argument_4 = reinterpret_cast<unsigned char *>
                                   (malloc((strlen((const char *)
                                   ((struct_fonction *) (l_element_courant
                                   ->donnee->objet))->nom_fonction)
                                   + 1) * sizeof(unsigned char)))) == NULL)
                           {
                               s_etat_processus->erreur_systeme =
                                       d_es_allocation_memoire;
                               return;
                           }
   
                           strcpy(reinterpret_cast<char *>(argument_4),
                                   (const char *) ((struct_fonction *)
                                   (l_element_courant->donnee->objet))
                                   ->nom_fonction);
                           break;
                       }
                   }
   
             recherche_type(s_etat_processus);                  l_element_courant = (*l_element_courant).suivant;
                   position++;
               }
   
             if (s_etat_processus->l_base_pile != NULL)              liberation(s_etat_processus, s_objet_argument_1);
               liberation(s_etat_processus, s_objet_argument_2);
   
               try
             {              {
                   int             direction;
   
                   if (argument_4 == NULL)
                   {
                       direction = 0;
                   }
                   else
                   {
                       direction = (strcmp((const char *) argument_4, "+") == 0)
                               ? 1 : -1;
                   }
   
                   gen expression(
                           string(reinterpret_cast<const char *>(argument_2)),
                           contexte);
                   identificateur variable(
                           string(reinterpret_cast<const char *>(argument_1)));
                   gen valeur(string(reinterpret_cast<const char *>
                           (argument_3)), contexte);
   
                   gen resultat = limit(expression, variable, valeur, direction,
                           contexte);
                   string chaine = "'" + resultat.print() + "'";
   
                 conversion_cas_vers_rpl(s_etat_processus,                  conversion_cas_vers_rpl(s_etat_processus,
                         s_etat_processus->l_base_pile->donnee);                          reinterpret_cast<unsigned char *>(const_cast<char *>(
                           chaine.c_str())));
               }
               catch(bad_alloc exception)
               {
                   s_etat_processus->erreur_systeme = d_es_allocation_memoire;
               }
               catch(...)
               {
                   s_etat_processus->erreur_execution = d_ex_erreur_interne_rplcas;
             }              }
   
             s_etat_processus->instruction_courante = registre;              free(argument_1);
               free(argument_2);
               free(argument_3);
   
             break;              if (argument_4 != NULL)
         }              {
                   free(argument_4);
               }
   
         case RPLCAS_LIMITE:  
         {  
             break;              break;
         }          }
     }      }
   
     return;      return;
   #else
   
       if (s_etat_processus->langue == 'F')
       {
           printf("+++Attention : RPL/CAS non compilé !\n");
       }
       else
       {
           printf("+++Warning : RPL/CAS not available !\n");
       }
   
       fflush(stdout);
   
       return;
   
   #endif
 }  }
   #pragma GCC diagnostic pop
   
 // vim: ts=4  // vim: ts=4
Removed from v.1.4  
changed lines
  Added in v.1.55

CVSweb interface <joel.bertrand@systella.fr>