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