1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.2
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:
22:
23: #ifdef RPLCAS
24: # include "giac.h"
25:
26: # undef PACKAGE
27: # undef PACKAGE_NAME
28: # undef PACKAGE_STRING
29: # undef PACKAGE_TARNAME
30: # undef PACKAGE_VERSION
31: # undef VERSION
32: #endif
33:
34: extern "C"
35: {
36: # define __RPLCAS
37: # include "rpl-conv.h"
38: }
39:
40: #include <iostream>
41:
42: using namespace std;
43:
44: #ifdef RPLCAS
45: using namespace giac;
46: #endif
47:
48:
49: static unsigned char *
50: conversion_rpl_vers_cas(struct_processus *s_etat_processus,
51: struct_objet **s_objet)
52: {
53: logical1 drapeau;
54:
55: struct_liste_chainee *l_element_courant;
56: struct_liste_chainee *l_element_precedent;
57:
58: struct_objet *s_objet_temporaire;
59:
60: t_8_bits registre[8];
61:
62: unsigned char *resultat;
63: unsigned char *index;
64:
65: for(int i = 0; i < 8; i++)
66: {
67: registre[i] = s_etat_processus->drapeaux_etat[i];
68: }
69:
70: sf(s_etat_processus, 35);
71: cf(s_etat_processus, 48);
72: cf(s_etat_processus, 49);
73: cf(s_etat_processus, 50);
74: cf(s_etat_processus, 53);
75: cf(s_etat_processus, 54);
76: cf(s_etat_processus, 55);
77: cf(s_etat_processus, 56);
78:
79: // GIAC considère que les fonctions sont écrites en minuscules. Le RPL/2
80: // part de l'hypothèse inverse. Il faut donc convertir en minuscules tous
81: // les noms de fonction. Les fonctions ne peuvent apparaître que dans le
82: // cas d'un objet de type ALG.
83:
84: if ((*s_objet)->type == NOM)
85: {
86: if (strcmp((const char *) reinterpret_cast<unsigned char *>(
87: reinterpret_cast<struct_nom *>((*s_objet)->objet)->nom),
88: "infinity") == 0)
89: {
90: if (evaluation(s_etat_processus, *s_objet, 'N') == d_erreur)
91: {
92: return(NULL);
93: }
94:
95: liberation(s_etat_processus, *s_objet);
96:
97: if (depilement(s_etat_processus, &(s_etat_processus
98: ->l_base_pile), s_objet) == d_erreur)
99: {
100: return(NULL);
101: }
102: }
103: }
104: else if ((*s_objet)->type == ALG)
105: {
106: if ((s_objet_temporaire = copie_objet(s_etat_processus,
107: (*s_objet), 'O')) == NULL)
108: {
109: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
110: return(NULL);
111: }
112:
113: liberation(s_etat_processus, (*s_objet));
114: (*s_objet) = s_objet_temporaire;
115:
116: // Si l'expression contient la fonction infinity, on commence par
117: // forcer une évaluation numérique.
118:
119: l_element_courant = reinterpret_cast<struct_liste_chainee *>(
120: (*s_objet)->objet);
121: drapeau = d_faux;
122:
123: while(l_element_courant != NULL)
124: {
125: if (l_element_courant->donnee->type == NOM)
126: {
127: if (strcmp((const char *) reinterpret_cast<unsigned char *>(
128: reinterpret_cast<struct_nom *>(
129: l_element_courant->donnee->objet)->nom),
130: "infinity") == 0)
131: {
132: drapeau = d_vrai;
133: break;
134: }
135: }
136:
137: l_element_courant = l_element_courant->suivant;
138: }
139:
140: if (drapeau == d_vrai)
141: {
142: if (evaluation(s_etat_processus, *s_objet, 'N') == d_erreur)
143: {
144: return(NULL);
145: }
146:
147: liberation(s_etat_processus, *s_objet);
148:
149: if (depilement(s_etat_processus, &(s_etat_processus
150: ->l_base_pile), s_objet) == d_erreur)
151: {
152: return(NULL);
153: }
154: }
155: }
156:
157: if ((*s_objet)->type == ALG)
158: {
159:
160: l_element_courant = reinterpret_cast<struct_liste_chainee *>(
161: (*s_objet)->objet);
162:
163: while(l_element_courant != NULL)
164: {
165: if (l_element_courant->donnee->type == FCT)
166: {
167: unsigned char *ptr;
168:
169: ptr = reinterpret_cast<unsigned char *>(
170: reinterpret_cast<struct_fonction *>(
171: l_element_courant->donnee->objet)->nom_fonction);
172:
173: while((*ptr) != d_code_fin_chaine)
174: {
175: int c = (*ptr);
176:
177: if (isalpha(c))
178: {
179: c = tolower(c);
180: (*ptr) = (unsigned char) c;
181: }
182:
183: ptr++;
184: }
185: }
186:
187: l_element_precedent = l_element_courant;
188: l_element_courant = l_element_courant->suivant;
189: }
190: }
191:
192: resultat = formateur(s_etat_processus, 0, (*s_objet));
193:
194: // Il faut remplacer les occurrences de 'relax' par ' +'.
195:
196: index = resultat;
197: while((index = reinterpret_cast<unsigned char *>(
198: strstr(reinterpret_cast<char *>(index),
199: (const char *) "relax"))) != NULL)
200: {
201: strncpy(reinterpret_cast<char *>(index), " +", 5);
202: }
203:
204: // Si le résultat vaut infinity, on rajoute le signe +.
205:
206: if (strcmp(reinterpret_cast<char *>(resultat), "infinity") == 0)
207: {
208: if ((resultat = reinterpret_cast<unsigned char *>(
209: realloc(resultat, (strlen(reinterpret_cast<char *>(
210: resultat)) + 2) * sizeof(unsigned char)))) == NULL)
211: {
212: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
213: return(NULL);
214: }
215:
216: strcpy(reinterpret_cast<char *>(resultat), "+infinity");
217: }
218:
219: if (resultat[0] == '\'')
220: {
221: resultat[0] = ' ';
222: resultat[strlen((const char *) resultat) - 1] = ' ';
223: }
224:
225: for(int i = 0; i < 8; i++)
226: {
227: s_etat_processus->drapeaux_etat[i] = registre[i];
228: }
229:
230: return(resultat);
231: }
232:
233:
234: static void
235: conversion_cas_vers_rpl(struct_processus *s_etat_processus,
236: unsigned char *expression)
237: {
238: logical1 drapeau;
239:
240: struct_liste_chainee *l_element_courant;
241: struct_liste_chainee *l_element_precedent;
242:
243: struct_objet *s_objet;
244:
245: unsigned char *registre;
246:
247: registre = s_etat_processus->instruction_courante;
248: s_etat_processus->instruction_courante = expression;
249: recherche_type(s_etat_processus);
250: s_etat_processus->instruction_courante = registre;
251:
252: if ((s_etat_processus->l_base_pile == NULL) ||
253: (s_etat_processus->erreur_execution != d_ex) ||
254: (s_etat_processus->erreur_systeme != d_es))
255: {
256: return;
257: }
258:
259: // Le niveau 1 de la pile opérationnelle contient l'expression
260: // à convertir.
261:
262: if (depilement(s_etat_processus, &(s_etat_processus
263: ->l_base_pile), &s_objet) == d_erreur)
264: {
265: return;
266: }
267:
268: if ((s_objet->type == ALG) || (s_objet->type == RPN))
269: {
270: // On transcrit les fonctions de GIAC vers le RPL/2.
271:
272: l_element_courant = reinterpret_cast<struct_liste_chainee *>(
273: s_objet->objet);
274: drapeau = d_faux;
275:
276: // S'il y a une valeur infini, on force l'évaluation de l'expression.
277:
278: while(l_element_courant != NULL)
279: {
280: if (l_element_courant->donnee->type == NOM)
281: {
282: if (strcmp((const char *) reinterpret_cast<unsigned char *>(
283: reinterpret_cast<struct_nom *>(
284: l_element_courant->donnee->objet)->nom),
285: "infinity") == 0)
286: {
287: drapeau = d_vrai;
288: break;
289: }
290: }
291:
292: l_element_courant = l_element_courant->suivant;
293: }
294:
295: if (drapeau == d_vrai)
296: {
297: if (evaluation(s_etat_processus, s_objet, 'N') == d_erreur)
298: {
299: return;
300: }
301:
302: liberation(s_etat_processus, s_objet);
303:
304: if (depilement(s_etat_processus, &(s_etat_processus
305: ->l_base_pile), &s_objet) == d_erreur)
306: {
307: return;
308: }
309: }
310: }
311:
312: if ((s_objet->type == ALG) || (s_objet->type == RPN))
313: {
314: l_element_precedent = NULL;
315: l_element_courant = reinterpret_cast<struct_liste_chainee *>(
316: s_objet->objet);
317:
318: while(l_element_courant != NULL)
319: {
320: if (l_element_courant->donnee->type == FCT)
321: {
322: // Nous sommes en présence d'un nom, donc de quelque chose
323: // qui n'est pas reconnu comme un mot-clef du RPL/2. S'il
324: // s'agit d'un mot-clef de GIAC, on le convertit.
325:
326: if ((strcmp((const char *)
327: reinterpret_cast<struct_fonction *>(l_element_courant
328: ->donnee->objet)->nom_fonction, "quote") == 0) ||
329: (strcmp((const char *)
330: reinterpret_cast<struct_fonction *>(l_element_courant
331: ->donnee->objet)->nom_fonction, "nop") == 0))
332: {
333: liberation(s_etat_processus, l_element_courant->donnee);
334:
335: if ((l_element_courant->donnee =
336: allocation(s_etat_processus, FCT)) == NULL)
337: {
338: s_etat_processus->erreur_systeme =
339: d_es_allocation_memoire;
340: return;
341: }
342:
343: if ((((struct_fonction *) l_element_courant->donnee->objet)
344: ->nom_fonction = reinterpret_cast<unsigned char *>(
345: malloc(6 * sizeof(unsigned char))))
346: == NULL)
347: {
348: s_etat_processus->erreur_systeme =
349: d_es_allocation_memoire;
350: return;
351: }
352:
353: strcpy(reinterpret_cast<char *>(
354: reinterpret_cast<struct_fonction *>(
355: l_element_courant->donnee->objet)->nom_fonction),
356: "RELAX");
357: }
358: }
359:
360: l_element_precedent = l_element_courant;
361: l_element_courant = l_element_courant->suivant;
362: }
363: }
364:
365: if (empilement(s_etat_processus, &(s_etat_processus->l_base_pile),
366: s_objet) == d_erreur)
367: {
368: return;
369: }
370:
371: return;
372: }
373:
374:
375: /*
376: ================================================================================
377: Fonction 'interface_cas'
378: ================================================================================
379: Entrées : commande à effectuer.
380: Le contrôle des types est effectué dans la fonction appelant interface_cas().
381: --------------------------------------------------------------------------------
382: Sorties : retour par la pile.
383: --------------------------------------------------------------------------------
384: Effets de bord : néant
385: ================================================================================
386: */
387:
388: void
389: interface_cas(struct_processus *s_etat_processus,
390: enum t_rplcas_commandes commande)
391: {
392: # ifdef RPLCAS
393: struct_objet *s_objet_argument_1;
394: struct_objet *s_objet_argument_2;
395: struct_objet *s_objet_temporaire;
396:
397: struct_liste_chainee *l_element_courant;
398:
399: unsigned char *argument_1;
400: unsigned char *argument_2;
401: unsigned char *argument_3;
402: unsigned char *argument_4;
403:
404: unsigned int position;
405:
406: switch(commande)
407: {
408: case RPLCAS_INTEGRATION:
409: {
410: if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
411: &s_objet_argument_1) == d_erreur)
412: {
413: s_etat_processus->erreur_execution = d_ex_manque_argument;
414: return;
415: }
416:
417: if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
418: &s_objet_argument_2) == d_erreur)
419: {
420: liberation(s_etat_processus, s_objet_argument_1);
421: s_etat_processus->erreur_execution = d_ex_manque_argument;
422: return;
423: }
424:
425: if ((argument_1 = conversion_rpl_vers_cas(s_etat_processus,
426: &s_objet_argument_1)) == NULL)
427: {
428: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
429: return;
430: }
431:
432: if ((argument_2 = conversion_rpl_vers_cas(s_etat_processus,
433: &s_objet_argument_2)) == NULL)
434: {
435: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
436: return;
437: }
438:
439: liberation(s_etat_processus, s_objet_argument_1);
440: liberation(s_etat_processus, s_objet_argument_2);
441:
442: try
443: {
444: giac::context contexte;
445:
446: gen variable(
447: string(reinterpret_cast<const char *>(argument_1)),
448: &contexte);
449: gen expression(
450: string(reinterpret_cast<const char *>(argument_2)),
451: &contexte);
452:
453: gen resultat = integrate_gen(expression, variable, &contexte);
454: string chaine = "'" + resultat.print() + "'";
455:
456: conversion_cas_vers_rpl(s_etat_processus,
457: reinterpret_cast<unsigned char *>(const_cast<char *>(
458: chaine.c_str())));
459: }
460: catch(bad_alloc exception)
461: {
462: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
463: }
464: catch(...)
465: {
466: s_etat_processus->erreur_execution = d_ex_erreur_interne_rplcas;
467: }
468:
469: free(argument_1);
470: free(argument_2);
471:
472: break;
473: }
474:
475: case RPLCAS_LIMITE:
476: {
477: if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
478: &s_objet_argument_1) == d_erreur)
479: {
480: s_etat_processus->erreur_execution = d_ex_manque_argument;
481: return;
482: }
483:
484: if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
485: &s_objet_argument_2) == d_erreur)
486: {
487: liberation(s_etat_processus, s_objet_argument_1);
488: s_etat_processus->erreur_execution = d_ex_manque_argument;
489: return;
490: }
491:
492: // Fonction
493:
494: if ((argument_2 = conversion_rpl_vers_cas(s_etat_processus,
495: &s_objet_argument_2)) == NULL)
496: {
497: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
498: return;
499: }
500:
501: // On parcourt la liste. Cette liste est tout d'abord copiée
502: // car on est susceptible de modifier le second élément.
503:
504: if ((s_objet_temporaire = copie_objet(s_etat_processus,
505: s_objet_argument_1, 'O')) == NULL)
506: {
507: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
508: return;
509: }
510:
511: liberation(s_etat_processus, s_objet_argument_1);
512: s_objet_argument_1 = s_objet_temporaire;
513:
514: l_element_courant = reinterpret_cast<struct_liste_chainee *>
515: (s_objet_argument_1->objet);
516: position = 1;
517: argument_4 = NULL;
518:
519: while(l_element_courant != NULL)
520: {
521: switch(position)
522: {
523: case 1:
524: {
525: // Variable
526:
527: if ((argument_1 = reinterpret_cast<unsigned char *>
528: (malloc((strlen((const char *)
529: ((struct_variable *) (l_element_courant
530: ->donnee->objet))->nom)
531: + 1) * sizeof(unsigned char)))) == NULL)
532: {
533: s_etat_processus->erreur_systeme =
534: d_es_allocation_memoire;
535: return;
536: }
537:
538: strcpy(reinterpret_cast<char *>(argument_1),
539: (const char *) ((struct_variable *)
540: (l_element_courant->donnee->objet))->nom);
541: break;
542: }
543:
544: case 2:
545: {
546: // Valeur
547: if ((argument_3 = conversion_rpl_vers_cas(
548: s_etat_processus,
549: &(l_element_courant->donnee))) == NULL)
550: {
551: s_etat_processus->erreur_systeme =
552: d_es_allocation_memoire;
553: return;
554: }
555:
556: break;
557: }
558:
559: case 3:
560: {
561: // Direction
562:
563: if ((argument_4 = reinterpret_cast<unsigned char *>
564: (malloc((strlen((const char *)
565: ((struct_fonction *) (l_element_courant
566: ->donnee->objet))->nom_fonction)
567: + 1) * sizeof(unsigned char)))) == NULL)
568: {
569: s_etat_processus->erreur_systeme =
570: d_es_allocation_memoire;
571: return;
572: }
573:
574: strcpy(reinterpret_cast<char *>(argument_4),
575: (const char *) ((struct_fonction *)
576: (l_element_courant->donnee->objet))
577: ->nom_fonction);
578: break;
579: }
580: }
581:
582: l_element_courant = (*l_element_courant).suivant;
583: position++;
584: }
585:
586: liberation(s_etat_processus, s_objet_argument_1);
587: liberation(s_etat_processus, s_objet_argument_2);
588:
589: try
590: {
591: giac::context contexte;
592:
593: int direction;
594:
595: if (argument_4 == NULL)
596: {
597: direction = 0;
598: }
599: else
600: {
601: direction = (strcmp((const char *) argument_4, "+") == 0)
602: ? 1 : -1;
603: }
604:
605: gen expression(
606: string(reinterpret_cast<const char *>(argument_2)),
607: &contexte);
608: identificateur variable(
609: string(reinterpret_cast<const char *>(argument_1)));
610: gen valeur(string(reinterpret_cast<const char *>
611: (argument_3)), &contexte);
612:
613: gen resultat = limit(expression, variable, valeur, direction,
614: &contexte);
615: string chaine = "'" + resultat.print() + "'";
616:
617: conversion_cas_vers_rpl(s_etat_processus,
618: reinterpret_cast<unsigned char *>(const_cast<char *>(
619: chaine.c_str())));
620: }
621: catch(bad_alloc exception)
622: {
623: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
624: }
625: catch(...)
626: {
627: s_etat_processus->erreur_execution = d_ex_erreur_interne_rplcas;
628: }
629:
630: free(argument_1);
631: free(argument_2);
632: free(argument_3);
633:
634: if (argument_4 != NULL)
635: {
636: free(argument_4);
637: }
638:
639: break;
640: }
641: }
642:
643: return;
644:
645: #else
646:
647: if (s_etat_processus->langue == 'F')
648: {
649: printf("+++Attention : RPL/CAS non compilé !\n");
650: }
651: else
652: {
653: printf("+++Warning : RPL/CAS not available !\n");
654: }
655:
656: fflush(stdout);
657:
658: return;
659:
660: #endif
661: }
662:
663: // 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