Annotation of rpl/src/interface_cas.cpp, revision 1.8
1.1 bertrand 1: /*
2: ================================================================================
1.8 ! bertrand 3: RPL/2 (R) version 4.1.0
1.1 bertrand 4: Copyright (C) 1989-2011 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
1.2 bertrand 22:
23: #include "giac.h"
24:
1.3 bertrand 25: #undef PACKAGE
26: #undef PACKAGE_NAME
27: #undef PACKAGE_STRING
28: #undef PACKAGE_TARNAME
29: #undef PACKAGE_VERSION
30: #undef VERSION
31:
1.1 bertrand 32: extern "C"
33: {
1.3 bertrand 34: # define __RPLCAS
1.1 bertrand 35: # include "rpl-conv.h"
36: }
37:
38: #include <iostream>
39:
40: using namespace std;
1.2 bertrand 41: using namespace giac;
42:
1.1 bertrand 43:
1.4 bertrand 44: static unsigned char *
45: conversion_rpl_vers_cas(struct_processus *s_etat_processus,
46: struct_objet **s_objet)
47: {
48: struct_liste_chainee *l_element_courant;
49:
50: struct_objet *s_objet_temporaire;
51:
52: t_8_bits registre[8];
53:
54: unsigned char *resultat;
55:
56: for(int i = 0; i < 8; i++)
57: {
58: registre[i] = s_etat_processus->drapeaux_etat[i];
59: }
60:
61: cf(s_etat_processus, 48);
62: cf(s_etat_processus, 49);
63: cf(s_etat_processus, 50);
64: cf(s_etat_processus, 53);
65: cf(s_etat_processus, 54);
66: cf(s_etat_processus, 55);
67: cf(s_etat_processus, 56);
68:
69: // GIAC considère que les fonctions sont écrites en minuscules. Le RPL/2
70: // part de l'hypothèse inverse. Il faut donc convertir en minuscules tous
71: // les noms de fonction. Les fonctions ne peuvent apparaître que dans le
72: // cas d'un objet de type ALG.
73:
74: if ((*s_objet)->type == ALG)
75: {
76: if ((*s_objet)->nombre_occurrences > 1)
77: {
78: if ((s_objet_temporaire = copie_objet(s_etat_processus,
79: (*s_objet), 'O')) == NULL)
80: {
81: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
82: return(NULL);
83: }
84:
85: liberation(s_etat_processus, (*s_objet));
86: (*s_objet) = s_objet_temporaire;
87: }
88:
89: l_element_courant = reinterpret_cast<struct_liste_chainee *>(
90: (*s_objet)->objet);
91:
92: while(l_element_courant != NULL)
93: {
94: if (l_element_courant->donnee->type == FCT)
95: {
96: unsigned char *ptr;
97:
1.6 bertrand 98: ptr = reinterpret_cast<unsigned char *>(
99: reinterpret_cast<struct_fonction *>(
1.4 bertrand 100: l_element_courant->donnee->objet)->nom_fonction);
101:
102: while((*ptr) != d_code_fin_chaine)
103: {
104: int c = (*ptr);
105:
106: if (isalpha(c))
107: {
108: c = tolower(c);
109: (*ptr) = (unsigned char) c;
110: }
111:
112: ptr++;
113: }
114: }
115:
116: l_element_courant = l_element_courant->suivant;
117: }
118: }
119:
120: resultat = formateur(s_etat_processus, 0, (*s_objet));
121: resultat[0] = ' ';
122: resultat[strlen((const char *) resultat) - 1] = ' ';
123:
124: for(int i = 0; i < 8; i++)
125: {
126: s_etat_processus->drapeaux_etat[i] = registre[i];
127: }
128:
129: return(resultat);
130: }
131:
132:
133: static void
134: conversion_cas_vers_rpl(struct_processus *s_etat_processus,
135: struct_objet *s_objet)
136: {
137: struct_liste_chainee *l_element_courant;
138: struct_liste_chainee *l_element_precedent;
139:
140: if ((s_objet->type == ALG) || (s_objet->type == RPN))
141: {
142: // On transcrit les fonctions de GIAC vers le RPL/2.
143:
144: l_element_precedent = NULL;
145: l_element_courant = reinterpret_cast<struct_liste_chainee *>(
146: s_objet->objet);
147:
148: while(l_element_courant != NULL)
149: {
150: if (l_element_courant->donnee->type == FCT)
151: {
152: // Nous sommes en présence d'un nom, donc de quelque chose
153: // qui n'est pas reconnu comme un mot-clef du RPL/2. S'il
154: // s'agit d'un mot-clef de GIAC, on le convertit.
155:
1.6 bertrand 156: if (strcmp((const char *)
157: reinterpret_cast<struct_fonction *>(l_element_courant
158: ->donnee->objet)->nom_fonction, "quote") == 0)
1.4 bertrand 159: {
160: liberation(s_etat_processus, l_element_courant->donnee);
161:
162: if ((l_element_courant->donnee =
163: allocation(s_etat_processus, FCT)) == NULL)
164: {
165: s_etat_processus->erreur_systeme =
166: d_es_allocation_memoire;
167: return;
168: }
169:
170: if ((((struct_fonction *) l_element_courant->donnee->objet)
171: ->nom_fonction = reinterpret_cast<unsigned char *>(
172: malloc(6 * sizeof(unsigned char))))
173: == NULL)
174: {
175: s_etat_processus->erreur_systeme =
176: d_es_allocation_memoire;
177: return;
178: }
179:
1.6 bertrand 180: strcpy(reinterpret_cast<char *>(
181: reinterpret_cast<struct_fonction *>(
1.4 bertrand 182: l_element_courant->donnee->objet)->nom_fonction),
183: "RELAX");
184: }
185: }
186:
187: l_element_precedent = l_element_courant;
188: l_element_courant = l_element_courant->suivant;
189: }
190: }
191:
192: return;
193: }
194:
195:
1.1 bertrand 196: /*
197: ================================================================================
198: Fonction 'interface_cas'
199: ================================================================================
1.4 bertrand 200: Entrées : commande à effectuer.
201: Le contrôle des types est effectué dans la fonction appelant interface_cas().
1.1 bertrand 202: --------------------------------------------------------------------------------
1.4 bertrand 203: Sorties : retour par la pile.
1.1 bertrand 204: --------------------------------------------------------------------------------
205: Effets de bord : néant
206: ================================================================================
207: */
208:
1.3 bertrand 209: void
1.1 bertrand 210: interface_cas(struct_processus *s_etat_processus,
1.3 bertrand 211: enum t_rplcas_commandes commande)
1.1 bertrand 212: {
1.4 bertrand 213: struct_objet *s_objet_argument_1;
214: struct_objet *s_objet_argument_2;
215:
1.3 bertrand 216: unsigned char *argument_1;
1.4 bertrand 217: unsigned char *argument_2;
218: unsigned char *registre;
1.3 bertrand 219:
220: switch(commande)
221: {
1.4 bertrand 222: case RPLCAS_INTEGRATION:
223: {
224: if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
225: &s_objet_argument_1) == d_erreur)
226: {
227: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
228: return;
229: }
230:
231: if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
232: &s_objet_argument_2) == d_erreur)
233: {
234: liberation(s_etat_processus, s_objet_argument_1);
235: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
236: return;
237: }
238:
239: if ((argument_1 = conversion_rpl_vers_cas(s_etat_processus,
240: &s_objet_argument_1)) == NULL)
241: {
242: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
243: return;
244: }
245:
246: if ((argument_2 = conversion_rpl_vers_cas(s_etat_processus,
247: &s_objet_argument_2)) == NULL)
248: {
249: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
250: return;
251: }
252:
253: liberation(s_etat_processus, s_objet_argument_1);
254: liberation(s_etat_processus, s_objet_argument_2);
255:
1.7 bertrand 256: try
257: {
258: giac::context contexte;
1.4 bertrand 259:
1.7 bertrand 260: gen variable(
261: string(reinterpret_cast<const char *>(argument_1)),
262: &contexte);
263: gen expression(
264: string(reinterpret_cast<const char *>(argument_2)),
265: &contexte);
266:
267: gen resultat = integrate(expression, variable, &contexte);
268: string chaine = "'" + resultat.print() + "'";
269:
270: registre = s_etat_processus->instruction_courante;
271: s_etat_processus->instruction_courante =
272: reinterpret_cast<unsigned char *>(const_cast<char *>
273: (chaine.c_str()));
274:
275: recherche_type(s_etat_processus);
276:
277: if (s_etat_processus->l_base_pile != NULL)
278: {
279: conversion_cas_vers_rpl(s_etat_processus,
280: s_etat_processus->l_base_pile->donnee);
281: }
1.4 bertrand 282:
1.7 bertrand 283: s_etat_processus->instruction_courante = registre;
284: }
285: catch(bad_alloc exception)
286: {
287: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
288: }
289: catch(...)
1.4 bertrand 290: {
1.7 bertrand 291: s_etat_processus->erreur_execution = d_ex_erreur_interne_rplcas;
1.4 bertrand 292: }
293:
1.7 bertrand 294: free(argument_1);
295: free(argument_2);
1.4 bertrand 296:
297: break;
298: }
299:
1.3 bertrand 300: case RPLCAS_LIMITE:
301: {
302: break;
303: }
304: }
1.1 bertrand 305:
1.3 bertrand 306: return;
1.1 bertrand 307: }
308:
309: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to interface_cas.cpp CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src