[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.1 and 1.23

version 1.1, 2011/06/23 13:03:39 version 1.23, 2012/01/17 14:44:12
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.1.0.prerelease.3    RPL/2 (R) version 4.1.6
   Copyright (C) 1989-2011 Dr. BERTRAND Joël    Copyright (C) 1989-2012 Dr. BERTRAND Joël
   
   This file is part of RPL/2.    This file is part of RPL/2.
   
Line 19 Line 19
 ================================================================================  ================================================================================
 */  */
   
   
   #ifdef RPLCAS
   
   // Giac inclut <semaphore.h> et définit sem_t. Or l'émulation
   // des IPCS POSIX requiert une redéfinition de sem_t.
   
   #   ifdef IPCS_SYSV
   //      NetBSD : _SEMAPHORE_H_
   #       define _SEMAPHORE_H_
   #   endif
   
   #   include "giac.h"
   
   #   undef PACKAGE
   #   undef PACKAGE_NAME
   #   undef PACKAGE_STRING
   #   undef PACKAGE_TARNAME
   #   undef PACKAGE_VERSION
   #   undef VERSION
   #endif
   
 extern "C"  extern "C"
 {  {
 #   undef _GNU_SOURCE  #   define __RPLCAS
 #   include "rpl-conv.h"  #   include "rpl-conv.h"
 }  }
   
 #include <iostream>  #include <iostream>
 #include "giac.h"  
   
 using namespace std;  using namespace std;
   
   #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 *
   conversion_rpl_vers_cas(struct_processus *s_etat_processus,
           struct_objet **s_objet)
   {
       logical1                drapeau;
   
       struct_liste_chainee    *l_element_courant;
   
       struct_objet            *s_objet_temporaire;
   
       t_8_bits                registre[8];
   
       unsigned char           *resultat;
       unsigned char           *index;
   
       for(int i = 0; i < 8; i++)
       {
           registre[i] = s_etat_processus->drapeaux_etat[i];
       }
   
       sf(s_etat_processus, 35);
       cf(s_etat_processus, 48);
       cf(s_etat_processus, 49);
       cf(s_etat_processus, 50);
       cf(s_etat_processus, 53);
       cf(s_etat_processus, 54);
       cf(s_etat_processus, 55);
       cf(s_etat_processus, 56);
   
       // GIAC considère que les fonctions sont écrites en minuscules. Le RPL/2
       // part de l'hypothèse inverse. Il faut donc convertir en minuscules tous
       // les noms de fonction. Les fonctions ne peuvent apparaître que dans le
       // cas d'un objet de type ALG.
   
       if ((*s_objet)->type == NOM)
       {
           if (strcmp((const char *) reinterpret_cast<unsigned char *>(
                   reinterpret_cast<struct_nom *>((*s_objet)->objet)->nom),
                   "infinity") == 0)
           {
               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);
               }
           }
       }
       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 *>(
                   (*s_objet)->objet);
   
           while(l_element_courant != NULL)
           {
               if (l_element_courant->donnee->type == FCT)
               {
                   unsigned char       *ptr;
   
                   ptr = reinterpret_cast<unsigned char *>(
                           reinterpret_cast<struct_fonction *>(
                           l_element_courant->donnee->objet)->nom_fonction);
   
                   while((*ptr) != d_code_fin_chaine)
                   {
                       int c = (*ptr);
   
                       if (isalpha(c))
                       {
                           c = tolower(c);
                           (*ptr) = (unsigned char) c;
                       }
   
                       ptr++;
                   }
               }
   
               l_element_courant = l_element_courant->suivant;
           }
       }
   
       resultat = formateur(s_etat_processus, 0, (*s_objet));
   
       // 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++)
       {
           s_etat_processus->drapeaux_etat[i] = registre[i];
       }
   
       return(resultat);
   }
   
   
   static void
   conversion_cas_vers_rpl(struct_processus *s_etat_processus,
           unsigned char *expression)
   {
       logical1                    drapeau;
   
       struct_liste_chainee        *l_element_courant;
   
       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))
       {
           // On transcrit les fonctions de GIAC vers le RPL/2.
   
           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 *>(
                   s_objet->objet);
   
           while(l_element_courant != NULL)
           {
               if (l_element_courant->donnee->type == FCT)
               {
                   // Nous sommes en présence d'un nom, donc de quelque chose
                   // 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.
   
                   if ((strcmp((const char *)
                           reinterpret_cast<struct_fonction *>(l_element_courant
                           ->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);
   
                       if ((l_element_courant->donnee =
                               allocation(s_etat_processus, FCT)) == NULL)
                       {
                           s_etat_processus->erreur_systeme =
                                   d_es_allocation_memoire;
                           return;
                       }
   
                       if ((((struct_fonction *) l_element_courant->donnee->objet)
                               ->nom_fonction = reinterpret_cast<unsigned char *>(
                               malloc(6 * sizeof(unsigned char))))
                               == NULL)
                       {
                           s_etat_processus->erreur_systeme =
                                   d_es_allocation_memoire;
                           return;
                       }
   
                       strcpy(reinterpret_cast<char *>(
                               reinterpret_cast<struct_fonction *>(
                               l_element_courant->donnee->objet)->nom_fonction),
                               "RELAX");
                   }
               }
   
               l_element_courant = l_element_courant->suivant;
           }
       }
   
       if (empilement(s_etat_processus, &(s_etat_processus->l_base_pile),
               s_objet) == d_erreur)
       {
           return;
       }
   
       return;
   }
   #endif
   
   
 /*  /*
 ================================================================================  ================================================================================
   Fonction 'interface_cas'    Fonction 'interface_cas'
 ================================================================================  ================================================================================
   Entrées : commande à effectuer, argument    Entrées : commande à effectuer.
     Le contrôle des types est effectué dans la fonction appelant interface_cas().
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Sorties : néant    Sorties : retour par la pile.
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Effets de bord : néant    Effets de bord : néant
 ================================================================================  ================================================================================
 */  */
   
 unsigned char *  void
 interface_cas(struct_processus *s_etat_processus,  interface_cas(struct_processus *s_etat_processus,
         unsigned char *commande, unsigned char *argument)          enum t_rplcas_commandes commande)
 {  {
     gen e(string("x^2-1"));  #   ifdef RPLCAS
     cout << factor(e) << endl;      struct_objet            *s_objet_argument_1;
       struct_objet            *s_objet_argument_2;
       struct_objet            *s_objet_temporaire;
   
       struct_liste_chainee    *l_element_courant;
   
       unsigned char           *argument_1;
       unsigned char           *argument_2;
       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)
       {
           case RPLCAS_INTEGRATION:
           {
               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;
               }
   
               if ((argument_1 = conversion_rpl_vers_cas(s_etat_processus,
                       &s_objet_argument_1)) == NULL)
               {
                   s_etat_processus->erreur_systeme = d_es_allocation_memoire;
                   return;
               }
   
               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;
               }
   
               liberation(s_etat_processus, s_objet_argument_1);
               liberation(s_etat_processus, s_objet_argument_2);
   
               try
               {
                   gen variable(
                           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_2);
   
               break;
           }
   
           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;
                       }
   
                       case 2:
                       {
                           // Valeur
                           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;
                       }
                   }
   
                   l_element_courant = (*l_element_courant).suivant;
                   position++;
               }
   
               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,
                           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_2);
               free(argument_3);
   
               if (argument_4 != NULL)
               {
                   free(argument_4);
               }
   
               break;
           }
       }
   
       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;
   
     return(NULL);  #endif
 }  }
   
 // vim: ts=4  // vim: ts=4
Removed from v.1.1  
changed lines
  Added in v.1.23

CVSweb interface <joel.bertrand@systella.fr>