Annotation of rpl/src/interface_cas.cpp, revision 1.5
1.1 bertrand 1: /*
2: ================================================================================
1.5 ! bertrand 3: RPL/2 (R) version 4.1.0.prerelease.4
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:
98: ptr = reinterpret_cast<unsigned char *>(((struct_fonction *)
99: l_element_courant->donnee->objet)->nom_fonction);
100:
101: while((*ptr) != d_code_fin_chaine)
102: {
103: int c = (*ptr);
104:
105: if (isalpha(c))
106: {
107: c = tolower(c);
108: (*ptr) = (unsigned char) c;
109: }
110:
111: ptr++;
112: }
113: }
114:
115: l_element_courant = l_element_courant->suivant;
116: }
117: }
118:
119: resultat = formateur(s_etat_processus, 0, (*s_objet));
120: resultat[0] = ' ';
121: resultat[strlen((const char *) resultat) - 1] = ' ';
122:
123: for(int i = 0; i < 8; i++)
124: {
125: s_etat_processus->drapeaux_etat[i] = registre[i];
126: }
127:
128: return(resultat);
129: }
130:
131:
132: static void
133: conversion_cas_vers_rpl(struct_processus *s_etat_processus,
134: struct_objet *s_objet)
135: {
136: struct_liste_chainee *l_element_courant;
137: struct_liste_chainee *l_element_precedent;
138:
139: if ((s_objet->type == ALG) || (s_objet->type == RPN))
140: {
141: // On transcrit les fonctions de GIAC vers le RPL/2.
142:
143: l_element_precedent = NULL;
144: l_element_courant = reinterpret_cast<struct_liste_chainee *>(
145: s_objet->objet);
146:
147: while(l_element_courant != NULL)
148: {
149: if (l_element_courant->donnee->type == FCT)
150: {
151: // Nous sommes en présence d'un nom, donc de quelque chose
152: // qui n'est pas reconnu comme un mot-clef du RPL/2. S'il
153: // s'agit d'un mot-clef de GIAC, on le convertit.
154:
155: if (strcmp(const_cast<const char *>(reinterpret_cast<char *>(
156: ((struct_fonction *) l_element_courant->donnee
157: ->objet)->nom_fonction)), "quote") == 0)
158: {
159: liberation(s_etat_processus, l_element_courant->donnee);
160:
161: if ((l_element_courant->donnee =
162: allocation(s_etat_processus, FCT)) == NULL)
163: {
164: s_etat_processus->erreur_systeme =
165: d_es_allocation_memoire;
166: return;
167: }
168:
169: if ((((struct_fonction *) l_element_courant->donnee->objet)
170: ->nom_fonction = reinterpret_cast<unsigned char *>(
171: malloc(6 * sizeof(unsigned char))))
172: == NULL)
173: {
174: s_etat_processus->erreur_systeme =
175: d_es_allocation_memoire;
176: return;
177: }
178:
179: strcpy(reinterpret_cast<char *>(((struct_fonction *)
180: l_element_courant->donnee->objet)->nom_fonction),
181: "RELAX");
182: }
183: }
184:
185: l_element_precedent = l_element_courant;
186: l_element_courant = l_element_courant->suivant;
187: }
188: }
189:
190: return;
191: }
192:
193:
1.1 bertrand 194: /*
195: ================================================================================
196: Fonction 'interface_cas'
197: ================================================================================
1.4 bertrand 198: Entrées : commande à effectuer.
199: Le contrôle des types est effectué dans la fonction appelant interface_cas().
1.1 bertrand 200: --------------------------------------------------------------------------------
1.4 bertrand 201: Sorties : retour par la pile.
1.1 bertrand 202: --------------------------------------------------------------------------------
203: Effets de bord : néant
204: ================================================================================
205: */
206:
1.3 bertrand 207: void
1.1 bertrand 208: interface_cas(struct_processus *s_etat_processus,
1.3 bertrand 209: enum t_rplcas_commandes commande)
1.1 bertrand 210: {
1.4 bertrand 211: struct_objet *s_objet_argument_1;
212: struct_objet *s_objet_argument_2;
213:
1.3 bertrand 214: unsigned char *argument_1;
1.4 bertrand 215: unsigned char *argument_2;
216: unsigned char *registre;
1.3 bertrand 217:
218: switch(commande)
219: {
1.4 bertrand 220: case RPLCAS_INTEGRATION:
221: {
222: if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
223: &s_objet_argument_1) == d_erreur)
224: {
225: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
226: return;
227: }
228:
229: if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
230: &s_objet_argument_2) == d_erreur)
231: {
232: liberation(s_etat_processus, s_objet_argument_1);
233: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
234: return;
235: }
236:
237: if ((argument_1 = conversion_rpl_vers_cas(s_etat_processus,
238: &s_objet_argument_1)) == NULL)
239: {
240: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
241: return;
242: }
243:
244: if ((argument_2 = conversion_rpl_vers_cas(s_etat_processus,
245: &s_objet_argument_2)) == NULL)
246: {
247: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
248: return;
249: }
250:
251: liberation(s_etat_processus, s_objet_argument_1);
252: liberation(s_etat_processus, s_objet_argument_2);
253:
254: gen variable(string(reinterpret_cast<const char *>(argument_1)),
255: giac::context0);
256: gen expression(string(reinterpret_cast<const char *>(argument_2)),
257: giac::context0);
258:
259: free(argument_1);
260: free(argument_2);
261:
262: gen resultat = integrate(expression, variable, giac::context0);
263: string chaine = "'" + resultat.print() + "'";
264:
265: registre = s_etat_processus->instruction_courante;
266: s_etat_processus->instruction_courante =
267: reinterpret_cast<unsigned char*>(const_cast<char *>
268: (chaine.c_str()));
269:
270: recherche_type(s_etat_processus);
271:
272: if (s_etat_processus->l_base_pile != NULL)
273: {
274: conversion_cas_vers_rpl(s_etat_processus,
275: s_etat_processus->l_base_pile->donnee);
276: }
277:
278: s_etat_processus->instruction_courante = registre;
279:
280: break;
281: }
282:
1.3 bertrand 283: case RPLCAS_LIMITE:
284: {
285: break;
286: }
287: }
1.1 bertrand 288:
1.3 bertrand 289: return;
1.1 bertrand 290: }
291:
292: // 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