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