version 1.2, 2011/06/23 13:41:16
|
version 1.10, 2011/07/22 20:34:57
|
Line 1
|
Line 1
|
/* |
/* |
================================================================================ |
================================================================================ |
RPL/2 (R) version 4.1.0.prerelease.3 |
RPL/2 (R) version 4.1.1 |
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 |