--- rpl/src/interface_cas.cpp 2011/08/03 09:26:47 1.12 +++ rpl/src/interface_cas.cpp 2017/08/03 17:17:49 1.55 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.1.2 - 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. @@ -21,7 +21,24 @@ #ifdef RPLCAS + +// 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 @@ -45,7 +62,29 @@ using namespace std; 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) @@ -53,7 +92,6 @@ conversion_rpl_vers_cas(struct_processus logical1 drapeau; struct_liste_chainee *l_element_courant; - struct_liste_chainee *l_element_precedent; struct_objet *s_objet_temporaire; @@ -184,7 +222,6 @@ conversion_rpl_vers_cas(struct_processus } } - l_element_precedent = l_element_courant; l_element_courant = l_element_courant->suivant; } } @@ -233,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); @@ -288,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 /* @@ -310,11 +420,13 @@ 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 +#ifdef RPLCAS struct_objet *s_objet_argument_1; struct_objet *s_objet_argument_2; struct_objet *s_objet_temporaire; @@ -325,10 +437,38 @@ interface_cas(struct_processus *s_etat_p unsigned char *argument_2; unsigned char *argument_3; unsigned char *argument_4; - unsigned char *registre; 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) { case RPLCAS_INTEGRATION: @@ -367,32 +507,20 @@ 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_gen(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())); - - 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; + conversion_cas_vers_rpl(s_etat_processus, + reinterpret_cast(const_cast( + chaine.c_str()))); } catch(bad_alloc exception) { @@ -451,6 +579,8 @@ interface_cas(struct_processus *s_etat_p 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) @@ -525,8 +655,6 @@ interface_cas(struct_processus *s_etat_p try { - giac::context contexte; - int direction; if (argument_4 == NULL) @@ -541,30 +669,19 @@ interface_cas(struct_processus *s_etat_p gen expression( string(reinterpret_cast(argument_2)), - &contexte); + contexte); identificateur variable( string(reinterpret_cast(argument_1))); gen valeur(string(reinterpret_cast - (argument_3)), &contexte); + (argument_3)), contexte); gen resultat = limit(expression, variable, valeur, direction, - &contexte); + 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; + conversion_cas_vers_rpl(s_etat_processus, + reinterpret_cast(const_cast( + chaine.c_str()))); } catch(bad_alloc exception) { @@ -589,7 +706,6 @@ interface_cas(struct_processus *s_etat_p } return; - #else if (s_etat_processus->langue == 'F') @@ -607,5 +723,6 @@ interface_cas(struct_processus *s_etat_p #endif } +#pragma GCC diagnostic pop // vim: ts=4