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