--- rpl/src/interface_cas.cpp 2011/06/25 10:40:48 1.7 +++ rpl/src/interface_cas.cpp 2017/08/03 17:17:49 1.55 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.1.0.prerelease.4 - Copyright (C) 1989-2011 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.28 + Copyright (C) 1989-2017 Dr. BERTRAND Joël This file is part of RPL/2. @@ -20,14 +20,33 @@ */ -#include "giac.h" +#ifdef RPLCAS -#undef PACKAGE -#undef PACKAGE_NAME -#undef PACKAGE_STRING -#undef PACKAGE_TARNAME -#undef PACKAGE_VERSION -#undef VERSION +// Giac inclut 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_ +// 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" { @@ -38,13 +57,40 @@ extern "C" #include 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( + 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; @@ -52,12 +98,14 @@ conversion_rpl_vers_cas(struct_processus 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); @@ -71,20 +119,81 @@ conversion_rpl_vers_cas(struct_processus // 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)->type == NOM) { - if ((*s_objet)->nombre_occurrences > 1) + if (strcmp((const char *) reinterpret_cast( + reinterpret_cast((*s_objet)->objet)->nom), + "infinity") == 0) { - if ((s_objet_temporaire = copie_objet(s_etat_processus, - (*s_objet), 'O')) == NULL) + 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( + (*s_objet)->objet); + drapeau = d_faux; + + while(l_element_courant != NULL) + { + if (l_element_courant->donnee->type == NOM) + { + if (strcmp((const char *) reinterpret_cast( + reinterpret_cast( + 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) { - s_etat_processus->erreur_systeme = d_es_allocation_memoire; return(NULL); } - liberation(s_etat_processus, (*s_objet)); - (*s_objet) = s_objet_temporaire; + 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( (*s_objet)->objet); @@ -118,8 +227,37 @@ conversion_rpl_vers_cas(struct_processus } 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( + strstr(reinterpret_cast(index), + (const char *) "relax"))) != NULL) + { + strncpy(reinterpret_cast(index), " +", 5); + } + + // Si le résultat vaut infinity, on rajoute le signe +. + + if (strcmp(reinterpret_cast(resultat), "infinity") == 0) + { + if ((resultat = reinterpret_cast( + realloc(resultat, (strlen(reinterpret_cast( + resultat)) + 2) * sizeof(unsigned char)))) == NULL) + { + s_etat_processus->erreur_systeme = d_es_allocation_memoire; + return(NULL); + } + + strcpy(reinterpret_cast(resultat), "+infinity"); + } + + if (resultat[0] == '\'') + { + resultat[0] = ' '; + resultat[strlen((const char *) resultat) - 1] = ' '; + } for(int i = 0; i < 8; i++) { @@ -132,16 +270,83 @@ conversion_rpl_vers_cas(struct_processus static void 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_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)) { // On transcrit les fonctions de GIAC vers le RPL/2. - l_element_precedent = NULL; + l_element_courant = reinterpret_cast( + 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( + reinterpret_cast( + 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( s_objet->objet); @@ -153,9 +358,12 @@ conversion_cas_vers_rpl(struct_processus // 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 *) + if ((strcmp((const char *) + reinterpret_cast(l_element_courant + ->donnee->objet)->nom_fonction, "quote") == 0) || + (strcmp((const char *) reinterpret_cast(l_element_courant - ->donnee->objet)->nom_fonction, "quote") == 0) + ->donnee->objet)->nom_fonction, "nop") == 0)) { liberation(s_etat_processus, l_element_courant->donnee); @@ -184,13 +392,19 @@ conversion_cas_vers_rpl(struct_processus } } - l_element_precedent = l_element_courant; 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 /* @@ -206,16 +420,54 @@ conversion_cas_vers_rpl(struct_processus ================================================================================ */ +#pragma GCC diagnostic push +#pragma GCC diagnostic ignored "-Wunused-parameter" 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; + struct_objet *s_objet_temporaire; + + struct_liste_chainee *l_element_courant; unsigned char *argument_1; 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( + s_etat_processus->contexte_cas); + + if ((s_etat_processus->erreur_execution != d_ex) || + (s_etat_processus->erreur_systeme != d_es)) + { + return; + } switch(commande) { @@ -224,7 +476,7 @@ interface_cas(struct_processus *s_etat_p 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; + s_etat_processus->erreur_execution = d_ex_manque_argument; return; } @@ -232,7 +484,7 @@ interface_cas(struct_processus *s_etat_p &s_objet_argument_2) == d_erreur) { 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; } @@ -255,32 +507,181 @@ interface_cas(struct_processus *s_etat_p try { - giac::context contexte; - gen variable( string(reinterpret_cast(argument_1)), - &contexte); + contexte); gen expression( string(reinterpret_cast(argument_2)), - &contexte); + contexte); - gen resultat = integrate(expression, variable, &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())); + conversion_cas_vers_rpl(s_etat_processus, + reinterpret_cast(const_cast( + 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 - recherche_type(s_etat_processus); + 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; + } - if (s_etat_processus->l_base_pile != NULL) + // 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 + (s_objet_argument_1->objet); + position = 1; + argument_1 = NULL; + argument_3 = NULL; + argument_4 = NULL; + + while(l_element_courant != NULL) + { + switch(position) { - conversion_cas_vers_rpl(s_etat_processus, - s_etat_processus->l_base_pile->donnee); + case 1: + { + // Variable + + if ((argument_1 = reinterpret_cast + (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(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 + (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(argument_4), + (const char *) ((struct_fonction *) + (l_element_courant->donnee->objet)) + ->nom_fonction); + break; + } } - s_etat_processus->instruction_courante = registre; + 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(argument_2)), + contexte); + identificateur variable( + string(reinterpret_cast(argument_1))); + gen valeur(string(reinterpret_cast + (argument_3)), contexte); + + gen resultat = limit(expression, variable, valeur, direction, + contexte); + string chaine = "'" + resultat.print() + "'"; + + conversion_cas_vers_rpl(s_etat_processus, + reinterpret_cast(const_cast( + chaine.c_str()))); } catch(bad_alloc exception) { @@ -293,17 +694,35 @@ interface_cas(struct_processus *s_etat_p free(argument_1); free(argument_2); + free(argument_3); - break; - } + if (argument_4 != NULL) + { + free(argument_4); + } - 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; + +#endif } +#pragma GCC diagnostic pop // vim: ts=4