[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.2 and 1.11

version 1.2, 2011/06/23 13:41:16 version 1.11, 2011/07/25 07:44:59
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.1.0.prerelease.3    RPL/2 (R) version 4.1.2
   Copyright (C) 1989-2011 Dr. BERTRAND Joël    Copyright (C) 1989-2011 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
   #   include "giac.h"
 extern "C"  
 {  
   
 #   undef PACKAGE  #   undef PACKAGE
 #   undef PACKAGE_NAME  #   undef PACKAGE_NAME
Line 31  extern "C" Line 29  extern "C"
 #   undef PACKAGE_TARNAME  #   undef PACKAGE_TARNAME
 #   undef PACKAGE_VERSION  #   undef PACKAGE_VERSION
 #   undef VERSION  #   undef VERSION
   #endif
   
 #   undef _GNU_SOURCE  extern "C"
 #   undef _POSIX_C_SOURCE  {
   #   define __RPLCAS
 #   include "rpl-conv.h"  #   include "rpl-conv.h"
 }  }
   
 #include <iostream>  #include <iostream>
   
 using namespace std;  using namespace std;
 using namespace giac;  
   #ifdef RPLCAS
       using namespace giac;
   #endif
   
   
   static unsigned char *
   conversion_rpl_vers_cas(struct_processus *s_etat_processus,
           struct_objet **s_objet)
   {
       struct_liste_chainee    *l_element_courant;
   
       struct_objet            *s_objet_temporaire;
   
       t_8_bits                registre[8];
   
       unsigned char           *resultat;
   
       for(int i = 0; i < 8; i++)
       {
           registre[i] = s_etat_processus->drapeaux_etat[i];
       }
   
       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 == ALG)
       {
           if ((*s_objet)->nombre_occurrences > 1)
           {
               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;
           }
   
           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));
       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,
           struct_objet *s_objet)
   {
       struct_liste_chainee        *l_element_courant;
       struct_liste_chainee        *l_element_precedent;
   
       if ((s_objet->type == ALG) || (s_objet->type == RPN))
       {
           // 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);
   
           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)
                   {
                       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_precedent = l_element_courant;
               l_element_courant = l_element_courant->suivant;
           }
       }
   
       return;
   }
   
   
 /*  /*
 ================================================================================  ================================================================================
   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, const char *argument)          enum t_rplcas_commandes commande)
 {  {
     gen e(string(argument), giac::context0);  #   ifdef RPLCAS
     //cout << factor(e) << endl;      struct_objet            *s_objet_argument_1;
       struct_objet            *s_objet_argument_2;
   
       unsigned char           *argument_1;
       unsigned char           *argument_2;
       unsigned char           *registre;
   
       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
               {
                   giac::context   contexte;
   
                   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() + "'";
   
                   registre = s_etat_processus->instruction_courante;
                   s_etat_processus->instruction_courante =
                           reinterpret_cast<unsigned char *>(const_cast<char *>
                           (chaine.c_str()));
   
                   recherche_type(s_etat_processus);
   
                   if (s_etat_processus->l_base_pile != NULL)
                   {
                       conversion_cas_vers_rpl(s_etat_processus,
                               s_etat_processus->l_base_pile->donnee);
                   }
   
                   s_etat_processus->instruction_courante = registre;
               }
               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:
           {
               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.2  
changed lines
  Added in v.1.11

CVSweb interface <joel.bertrand@systella.fr>