--- rpl/src/interface_cas.cpp 2011/06/24 09:10:37 1.3 +++ rpl/src/interface_cas.cpp 2011/07/25 07:44:59 1.11 @@ -1,6 +1,6 @@ /* ================================================================================ - RPL/2 (R) version 4.1.0.prerelease.3 + RPL/2 (R) version 4.1.2 Copyright (C) 1989-2011 Dr. BERTRAND Joël This file is part of RPL/2. @@ -20,14 +20,16 @@ */ -#include "giac.h" +#ifdef RPLCAS +# include "giac.h" -#undef PACKAGE -#undef PACKAGE_NAME -#undef PACKAGE_STRING -#undef PACKAGE_TARNAME -#undef PACKAGE_VERSION -#undef VERSION +# undef PACKAGE +# undef PACKAGE_NAME +# undef PACKAGE_STRING +# undef PACKAGE_TARNAME +# undef PACKAGE_VERSION +# undef VERSION +#endif extern "C" { @@ -38,16 +40,172 @@ extern "C" #include 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( + (*s_objet)->objet); + + while(l_element_courant != NULL) + { + if (l_element_courant->donnee->type == FCT) + { + unsigned char *ptr; + + ptr = reinterpret_cast( + reinterpret_cast( + 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( + 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(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( + malloc(6 * sizeof(unsigned char)))) + == NULL) + { + s_etat_processus->erreur_systeme = + d_es_allocation_memoire; + return; + } + + strcpy(reinterpret_cast( + reinterpret_cast( + 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' ================================================================================ - 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 ================================================================================ @@ -57,20 +215,118 @@ void interface_cas(struct_processus *s_etat_processus, enum t_rplcas_commandes commande) { +# ifdef RPLCAS + 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(argument_1)), + &contexte); + gen expression( + string(reinterpret_cast(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(const_cast + (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 - gen e(string(reinterpret_cast(argument_1)), - giac::context0); + 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 } // vim: ts=4