Return to instructions_e1.c CVS log | Up to [local] / rpl / src |
1.1 bertrand 1: /*
2: ================================================================================
1.55 ! bertrand 3: RPL/2 (R) version 4.1.21
1.52 bertrand 4: Copyright (C) 1989-2015 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:
22:
1.12 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 24:
25:
26: /*
27: ================================================================================
28: Fonction 'eval'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_eval(struct_processus *s_etat_processus)
40: {
41: logical1 last_valide;
42:
43: struct_objet *s_objet;
44: struct_objet *s_objet_simplifie;
45:
46: unsigned char registre_type_evaluation;
47:
48: (*s_etat_processus).erreur_execution = d_ex;
49:
50: if ((*s_etat_processus).affichage_arguments == 'Y')
51: {
52: printf("\n EVAL ");
53:
54: if ((*s_etat_processus).langue == 'F')
55: {
56: printf("(évaluation d'un objet)\n\n");
57: }
58: else
59: {
60: printf("(object evaluation)\n\n");
61: }
62:
63: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
64: " %s, %s, %s, %s, %s,\n"
65: " %s, %s, %s, %s, %s,\n"
66: " %s\n",
67: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
68: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
69: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
70: " %s, %s, %s, %s, %s,\n"
71: " %s, %s, %s, %s, %s,\n"
72: " %s\n",
73: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
74: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
75: printf(" ...\n");
76: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
77: " %s, %s, %s, %s, %s,\n"
78: " %s, %s, %s, %s, %s,\n"
79: " %s\n",
80: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
81: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
82:
83: return;
84: }
85: else if ((*s_etat_processus).test_instruction == 'Y')
86: {
87: (*s_etat_processus).nombre_arguments = -1;
88: return;
89: }
90:
91: if ((last_valide = test_cfsf(s_etat_processus, 31)) == d_vrai)
92: {
93: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
94: {
95: return;
96: }
97:
98: cf(s_etat_processus, 31);
99: }
100:
101: registre_type_evaluation = (test_cfsf(s_etat_processus, 35) == d_vrai)
102: ? 'E' : 'N';
103: sf(s_etat_processus, 35);
104:
105: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
106: &s_objet) == d_erreur)
107: {
108: if (last_valide == d_vrai)
109: {
110: sf(s_etat_processus, 31);
111: }
112:
113: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
114: return;
115: }
116:
117: if ((s_objet_simplifie = simplification(s_etat_processus, s_objet)) == NULL)
118: {
119: if (last_valide == d_vrai)
120: {
121: sf(s_etat_processus, 31);
122: }
123:
1.51 bertrand 124: liberation(s_etat_processus, s_objet);
1.1 bertrand 125: return;
126: }
127:
128: liberation(s_etat_processus, s_objet);
129: s_objet = s_objet_simplifie;
130:
131: if ((*s_etat_processus).l_base_pile_systeme == NULL)
132: {
133: (*s_etat_processus).erreur_systeme = d_es_pile_vide;
134: return;
135: }
136:
137: (*(*s_etat_processus).l_base_pile_systeme).evaluation_expression = d_vrai;
138:
139: if (evaluation(s_etat_processus, s_objet, 'E') == d_erreur)
140: {
141: (*(*s_etat_processus).l_base_pile_systeme)
142: .evaluation_expression = d_faux;
143:
144: if (last_valide == d_vrai)
145: {
146: sf(s_etat_processus, 31);
147: }
148:
149: liberation(s_etat_processus, s_objet);
150: return;
151: }
152:
153: (*(*s_etat_processus).l_base_pile_systeme).evaluation_expression = d_faux;
154: liberation(s_etat_processus, s_objet);
155:
156: if (registre_type_evaluation == 'E')
157: {
158: sf(s_etat_processus, 35);
159: }
160: else
161: {
162: cf(s_etat_processus, 35);
163: }
164:
165: if (last_valide == d_vrai)
166: {
167: sf(s_etat_processus, 31);
168: }
169:
170: return;
171: }
172:
173:
174: /*
175: ================================================================================
176: Fonction 'end'
177: ================================================================================
178: Entrées : structure processus
179: --------------------------------------------------------------------------------
180: Sorties :
181: --------------------------------------------------------------------------------
182: Effets de bord : néant
183: ================================================================================
184: */
185:
186: void
187: instruction_end(struct_processus *s_etat_processus)
188: {
1.10 bertrand 189: logical1 condition;
190:
191: struct_liste_pile_systeme *l_element_courant;
192:
1.1 bertrand 193: struct_objet *s_objet;
194:
195: (*s_etat_processus).erreur_execution = d_ex;
196:
197: if ((*s_etat_processus).affichage_arguments == 'Y')
198: {
199: printf("\n END ");
200:
201: if ((*s_etat_processus).langue == 'F')
202: {
203: printf("(structure de contrôle)\n\n");
204: printf(" Utilisation :\n\n");
205: }
206: else
207: {
208: printf("(control statement)\n\n");
209: printf(" Usage:\n\n");
210: }
211:
212: printf(" IF\n");
213: printf(" (expression test 1)\n");
214: printf(" THEN\n");
215: printf(" (expression 1)\n");
216: printf(" [ELSEIF\n");
217: printf(" (expression test 2)\n");
218: printf(" THEN\n");
219: printf(" (expression 2)]\n");
220: printf(" ...\n");
221: printf(" [ELSE\n");
222: printf(" (expression n)]\n");
223: printf(" END\n\n");
224:
225: printf(" IFERR\n");
226: printf(" (expression test)\n");
227: printf(" THEN\n");
228: printf(" (expression 1)\n");
229: printf(" [ELSE\n");
230: printf(" (expression 2)]\n");
231: printf(" END\n\n");
232:
1.37 bertrand 233: printf(" CRITICAL\n");
234: printf(" (expression)\n");
235: printf(" END\n\n");
236:
1.1 bertrand 237: printf(" DO\n");
238: printf(" (expression)\n");
239: printf(" UNTIL\n");
240: printf(" (expression test)\n");
241: printf(" END\n\n");
242:
243: printf(" WHILE\n");
244: printf(" (expression test)\n");
245: printf(" REPEAT\n");
246: printf(" (expression)\n");
247: printf(" END\n\n");
248:
249: printf(" SELECT (expression test)\n");
250: printf(" CASE (clause 1) THEN (expression 1) END\n");
251: printf(" CASE (clause 2) THEN (expression 2) END\n");
252: printf(" ...\n");
253: printf(" CASE (clause n) THEN (expression n) END\n");
254: printf(" DEFAULT\n");
255: printf(" (expression)\n");
256: printf(" END\n\n");
257:
258: printf(" SELECT (expression test)\n");
259: printf(" CASE (clause 1) THEN (expression 1) END\n");
260: printf(" (expression)\n");
261: printf(" CASE (clause 2) THEN (expression 2) END\n");
262: printf(" END\n");
263:
264: return;
265: }
266: else if ((*s_etat_processus).test_instruction == 'Y')
267: {
268: (*s_etat_processus).nombre_arguments = -1;
269: return;
270: }
271:
1.37 bertrand 272: if ((*s_etat_processus).l_base_pile_systeme == NULL)
273: {
274: (*s_etat_processus).erreur_systeme = d_es_processus;
275: return;
276: }
277:
1.1 bertrand 278: if (((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'I')
279: || ((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'J'))
280: {
281: depilement_pile_systeme(s_etat_processus);
282:
283: if ((*s_etat_processus).erreur_systeme != d_es)
284: {
285: return;
286: }
287: }
288: else if ((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'D')
289: {
290: if ((*(*s_etat_processus).l_base_pile_systeme).clause != 'U')
291: {
292: (*s_etat_processus).erreur_execution =
293: d_ex_erreur_traitement_boucle;
294: return;
295: }
296:
297: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
298: &s_objet) == d_erreur)
299: {
300: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
301: return;
302: }
303:
304: if (((*s_objet).type == INT) ||
305: ((*s_objet).type == REL))
306: {
307: if ((*s_objet).type == INT)
308: {
309: condition = ((*((integer8 *) (*s_objet).objet)) == 0)
310: ? d_faux : d_vrai;
311: }
312: else
313: {
314: condition = ((*((real8 *) (*s_objet).objet)) == 0)
315: ? d_faux : d_vrai;
316: }
317:
318: if (condition == d_faux)
319: {
320: if ((*s_etat_processus).mode_execution_programme == 'Y')
321: {
322: (*s_etat_processus).position_courante =
323: (*(*s_etat_processus).l_base_pile_systeme)
324: .adresse_retour;
325: }
326: else
327: {
328: (*s_etat_processus).expression_courante =
329: (*(*s_etat_processus).l_base_pile_systeme)
330: .pointeur_objet_retour;
331: }
332: }
333: else
334: {
335: depilement_pile_systeme(s_etat_processus);
336:
337: if ((*s_etat_processus).erreur_systeme != d_es)
338: {
339: return;
340: }
341: }
342: }
343: else
344: {
345: liberation(s_etat_processus, s_objet);
346:
347: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
348: return;
349: }
350:
351: liberation(s_etat_processus, s_objet);
352: }
353: else if ((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'W')
354: {
355: if ((*(*s_etat_processus).l_base_pile_systeme).clause == 'W')
356: {
357: if ((*s_etat_processus).mode_execution_programme == 'Y')
358: {
359: (*s_etat_processus).position_courante =
360: (*(*s_etat_processus).l_base_pile_systeme)
361: .adresse_retour;
362: }
363: else
364: {
365: (*s_etat_processus).expression_courante =
366: (*(*s_etat_processus).l_base_pile_systeme)
367: .pointeur_objet_retour;
368: }
369: }
370: else
371: {
372: depilement_pile_systeme(s_etat_processus);
373:
374: if ((*s_etat_processus).erreur_systeme != d_es)
375: {
376: return;
377: }
378: }
379: }
380: else if ((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'C')
381: {
1.10 bertrand 382: depilement_pile_systeme(s_etat_processus);
383:
384: if ((*s_etat_processus).erreur_systeme != d_es)
1.1 bertrand 385: {
1.10 bertrand 386: return;
387: }
388: }
389: else if ((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'K')
390: {
391: l_element_courant = (*(*s_etat_processus).l_base_pile_systeme).suivant;
1.1 bertrand 392:
1.10 bertrand 393: while(l_element_courant != NULL)
394: {
395: switch((*l_element_courant).clause)
1.1 bertrand 396: {
1.10 bertrand 397: case 'K' :
398: case 'Q' :
399: case 'C' :
400: {
401: if ((*l_element_courant).clause == 'Q')
402: {
403: (*l_element_courant).clause = 'C';
404: }
405: else
406: {
407: (*l_element_courant).clause = (*(*s_etat_processus)
408: .l_base_pile_systeme).clause;
409: }
410:
411: l_element_courant = NULL;
412: break;
413: }
414:
415: default :
416: {
417: l_element_courant = (*l_element_courant).suivant;
418: break;
419: }
1.1 bertrand 420: }
421: }
1.10 bertrand 422:
423: depilement_pile_systeme(s_etat_processus);
424:
425: if ((*s_etat_processus).erreur_systeme != d_es)
1.1 bertrand 426: {
1.10 bertrand 427: return;
1.1 bertrand 428: }
429: }
1.37 bertrand 430: else if ((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'Q')
431: {
432: depilement_pile_systeme(s_etat_processus);
433:
434: if ((*s_etat_processus).erreur_systeme != d_es)
435: {
436: return;
437: }
438:
439: if (pthread_mutex_unlock(&mutex_sections_critiques) != 0)
440: {
441: (*s_etat_processus).erreur_systeme = d_es_processus;
442: return;
443: }
444:
445: (*s_etat_processus).sections_critiques--;
446: }
447: else
1.1 bertrand 448: {
449: (*s_etat_processus).erreur_systeme = d_es_end_incoherent;
450: }
451:
452: return;
453: }
454:
455:
456: /*
457: ================================================================================
458: Fonction 'else'
459: ================================================================================
460: Entrées : structure processus
461: --------------------------------------------------------------------------------
462: Sorties :
463: --------------------------------------------------------------------------------
464: Effets de bord : néant
465: ================================================================================
466: */
467:
468: void
469: instruction_else(struct_processus *s_etat_processus)
470: {
471: logical1 drapeau_fin;
472: logical1 execution;
473:
474: struct_liste_chainee *s_registre;
475:
476: unsigned char *instruction_majuscule;
477: unsigned char *tampon;
478:
1.43 bertrand 479: integer8 niveau;
1.1 bertrand 480:
481: void (*fonction)();
482:
483: (*s_etat_processus).erreur_execution = d_ex;
484:
485: if ((*s_etat_processus).affichage_arguments == 'Y')
486: {
487: printf("\n ELSE ");
488:
489: if ((*s_etat_processus).langue == 'F')
490: {
491: printf("(structure de contrôle)\n\n");
492: printf(" Utilisation :\n\n");
493: }
494: else
495: {
496: printf("(control statement)\n\n");
497: printf(" Usage:\n\n");
498: }
499:
500: printf(" IF\n");
501: printf(" (expression test 1)\n");
502: printf(" THEN\n");
503: printf(" (expression 1)\n");
504: printf(" [ELSEIF\n");
505: printf(" (expression test 2)\n");
506: printf(" THEN\n");
507: printf(" (expression 2)]\n");
508: printf(" ...\n");
509: printf(" ELSE\n");
510: printf(" (expression n)\n");
511: printf(" END\n");
512:
513: return;
514: }
515: else if ((*s_etat_processus).test_instruction == 'Y')
516: {
517: (*s_etat_processus).nombre_arguments = -1;
518: return;
519: }
520:
521: if ((*(*s_etat_processus).l_base_pile_systeme).clause == 'T')
522: {
523: niveau = 0;
524: drapeau_fin = d_faux;
525:
526: if ((*s_etat_processus).mode_execution_programme == 'Y')
527: {
528: tampon = (*s_etat_processus).instruction_courante;
529:
530: do
531: {
532: if (recherche_instruction_suivante(s_etat_processus)
533: == d_erreur)
534: {
535: if ((*s_etat_processus).instruction_courante != NULL)
536: {
537: free((*s_etat_processus).instruction_courante);
538: }
539:
540: (*s_etat_processus).instruction_courante = tampon;
541: (*s_etat_processus).erreur_execution =
542: d_ex_erreur_traitement_condition;
543: return;
544: }
545:
546: if ((instruction_majuscule = conversion_majuscule(
1.54 bertrand 547: s_etat_processus,
1.1 bertrand 548: (*s_etat_processus).instruction_courante)) == NULL)
549: {
550: free((*s_etat_processus).instruction_courante);
551: (*s_etat_processus).instruction_courante = tampon;
552: (*s_etat_processus).erreur_systeme =
553: d_es_allocation_memoire;
554: return;
555: }
556:
557: if (niveau == 0)
558: {
559: if (strcmp(instruction_majuscule, "END") == 0)
560: {
1.43 bertrand 561: (*s_etat_processus).position_courante -=
562: (((integer8) strlen(
563: instruction_majuscule)) + 1);
1.1 bertrand 564: drapeau_fin = d_vrai;
565: }
566: else
567: {
568: drapeau_fin = d_faux;
569: }
570: }
571: else
572: {
573: drapeau_fin = d_faux;
574: }
575:
576: if ((strcmp(instruction_majuscule, "CASE") == 0) ||
577: (strcmp(instruction_majuscule, "DO") == 0) ||
578: (strcmp(instruction_majuscule, "IF") == 0) ||
579: (strcmp(instruction_majuscule, "IFERR") == 0) ||
580: (strcmp(instruction_majuscule, "SELECT") == 0) ||
581: (strcmp(instruction_majuscule, "WHILE") == 0))
582: {
583: niveau++;
584: }
585: else if (strcmp(instruction_majuscule, "END") == 0)
586: {
587: niveau--;
588: }
589:
590: free(instruction_majuscule);
591: free((*s_etat_processus).instruction_courante);
592: } while(drapeau_fin == d_faux);
593:
594: (*s_etat_processus).instruction_courante = tampon;
595: }
596: else
597: {
598: /*
599: * Vérification du pointeur de prédiction de saut.
600: */
601:
602: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
603: .expression_courante).donnee).mutex)) != 0)
604: {
605: (*s_etat_processus).erreur_systeme = d_es_processus;
606: return;
607: }
608:
609: if ((*((struct_fonction *) (*(*(*s_etat_processus)
610: .expression_courante).donnee).objet)).prediction_saut
611: != NULL)
612: {
613: s_registre = (*s_etat_processus).expression_courante;
614:
615: (*s_etat_processus).expression_courante =
616: (struct_liste_chainee *)
617: (*((struct_fonction *) (*(*(*s_etat_processus)
618: .expression_courante).donnee).objet))
619: .prediction_saut;
620: fonction = (*((struct_fonction *)
621: (*(*(*s_etat_processus).expression_courante)
622: .donnee).objet)).fonction;
623: execution = (*((struct_fonction *)
624: (*(*s_registre).donnee).objet)).prediction_execution;
625:
626: if (pthread_mutex_unlock(&((*(*s_registre).donnee).mutex)) != 0)
627: {
628: (*s_etat_processus).erreur_systeme = d_es_processus;
629: return;
630: }
631:
632: if (execution == d_vrai)
633: {
634: fonction(s_etat_processus);
635: }
636: }
637: else
638: {
639: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
640: .expression_courante).donnee).mutex)) != 0)
641: {
642: (*s_etat_processus).erreur_systeme = d_es_processus;
643: return;
644: }
645:
646: s_registre = (*s_etat_processus).expression_courante;
647: execution = d_faux;
648:
649: do
650: {
651: if (((*s_etat_processus).expression_courante =
652: (*(*s_etat_processus).expression_courante).suivant)
653: == NULL)
654: {
655: (*s_etat_processus).erreur_execution =
656: d_ex_erreur_traitement_condition;
657: return;
658: }
659:
660: if ((*(*(*s_etat_processus).expression_courante)
661: .donnee).type == FCT)
662: {
663: fonction = (*((struct_fonction *)
664: (*(*(*s_etat_processus).expression_courante)
665: .donnee).objet)).fonction;
666:
667: if (niveau == 0)
668: {
669: if (fonction == instruction_end)
670: {
671: fonction(s_etat_processus);
672: execution = d_vrai;
673: drapeau_fin = d_vrai;
674: }
675: else
676: {
677: drapeau_fin = d_faux;
678: }
679: }
680: else
681: {
682: drapeau_fin = d_faux;
683: }
684:
685: if ((fonction == instruction_case) ||
686: (fonction == instruction_do) ||
687: (fonction == instruction_if) ||
688: (fonction == instruction_iferr) ||
689: (fonction == instruction_select) ||
690: (fonction == instruction_while))
691: {
692: niveau++;
693: }
694: else if (fonction == instruction_end)
695: {
696: niveau--;
697: }
698: }
699: } while(drapeau_fin == d_faux);
700:
701: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
702: .expression_courante).donnee).mutex)) != 0)
703: {
704: (*s_etat_processus).erreur_systeme = d_es_processus;
705: return;
706: }
707:
708: (*((struct_fonction *) (*(*s_registre).donnee).objet))
709: .prediction_saut = (*s_etat_processus)
710: .expression_courante;
711: (*((struct_fonction *) (*(*s_registre).donnee).objet))
712: .prediction_execution = execution;
713:
714: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
715: .expression_courante).donnee).mutex)) != 0)
716: {
717: (*s_etat_processus).erreur_systeme = d_es_processus;
718: return;
719: }
720: }
721: }
722: }
723: else if ((*(*s_etat_processus).l_base_pile_systeme).clause != 'E')
724: {
725: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_condition;
726: return;
727: }
728: else
729: {
730: (*(*s_etat_processus).l_base_pile_systeme).clause = 'Z';
731: }
732:
733: return;
734: }
735:
736:
737: /*
738: ================================================================================
739: Fonction 'elseif'
740: ================================================================================
741: Entrées : structure processus
742: --------------------------------------------------------------------------------
743: Sorties :
744: --------------------------------------------------------------------------------
745: Effets de bord : néant
746: ================================================================================
747: */
748:
749: void
750: instruction_elseif(struct_processus *s_etat_processus)
751: {
752: logical1 drapeau_fin;
753: logical1 execution;
754:
755: struct_liste_chainee *s_registre;
756:
757: unsigned char *instruction_majuscule;
758: unsigned char *tampon;
759:
1.43 bertrand 760: integer8 niveau;
1.1 bertrand 761:
762: void (*fonction)();
763:
764: (*s_etat_processus).erreur_execution = d_ex;
765:
766: if ((*s_etat_processus).affichage_arguments == 'Y')
767: {
768: printf("\n ELSEIF ");
769:
770: if ((*s_etat_processus).langue == 'F')
771: {
772: printf("(structure de contrôle)\n\n");
773: printf(" Utilisation :\n\n");
774: }
775: else
776: {
777: printf("(control statement)\n\n");
778: printf(" Usage:\n\n");
779: }
780:
781: printf(" IF\n");
782: printf(" (expression test 1)\n");
783: printf(" THEN\n");
784: printf(" (expression 1)\n");
785: printf(" ELSEIF\n");
786: printf(" (expression test 2)\n");
787: printf(" THEN\n");
788: printf(" (expression 2)\n");
789: printf(" ...\n");
790: printf(" [ELSE\n");
791: printf(" (expression n)]\n");
792: printf(" END\n\n");
793:
794: return;
795: }
796: else if ((*s_etat_processus).test_instruction == 'Y')
797: {
798: (*s_etat_processus).nombre_arguments = -1;
799: return;
800: }
801:
802: if ((*(*s_etat_processus).l_base_pile_systeme).type_cloture != 'I')
803: {
804: (*s_etat_processus).erreur_execution =
805: d_ex_erreur_traitement_condition;
806: return;
807: }
808:
809: if ((*(*s_etat_processus).l_base_pile_systeme).clause == 'T')
810: {
811: /*
812: * On saute au END car le test précédent était vrai.
813: */
814:
815: niveau = 0;
816: drapeau_fin = d_faux;
817:
818: if ((*s_etat_processus).mode_execution_programme == 'Y')
819: {
820: tampon = (*s_etat_processus).instruction_courante;
821:
822: do
823: {
824: if (recherche_instruction_suivante(s_etat_processus)
825: == d_erreur)
826: {
827: if ((*s_etat_processus).instruction_courante != NULL)
828: {
829: free((*s_etat_processus).instruction_courante);
830: }
831:
832: (*s_etat_processus).instruction_courante = tampon;
833: (*s_etat_processus).erreur_execution =
834: d_ex_erreur_traitement_condition;
835: return;
836: }
837:
838: if ((instruction_majuscule = conversion_majuscule(
1.54 bertrand 839: s_etat_processus,
1.1 bertrand 840: (*s_etat_processus).instruction_courante)) == NULL)
841: {
842: free((*s_etat_processus).instruction_courante);
843: (*s_etat_processus).instruction_courante = tampon;
844: (*s_etat_processus).erreur_systeme =
845: d_es_allocation_memoire;
846: return;
847: }
848:
849: if (niveau == 0)
850: {
851: if (strcmp(instruction_majuscule, "END") == 0)
852: {
1.43 bertrand 853: (*s_etat_processus).position_courante -=
854: (((integer8) strlen(
855: instruction_majuscule)) + 1);
1.1 bertrand 856: drapeau_fin = d_vrai;
857: }
858: else
859: {
860: drapeau_fin = d_faux;
861: }
862: }
863: else
864: {
865: drapeau_fin = d_faux;
866: }
867:
868: if ((strcmp(instruction_majuscule, "CASE") == 0) ||
869: (strcmp(instruction_majuscule, "DO") == 0) ||
870: (strcmp(instruction_majuscule, "IF") == 0) ||
871: (strcmp(instruction_majuscule, "IFERR") == 0) ||
872: (strcmp(instruction_majuscule, "SELECT") == 0) ||
873: (strcmp(instruction_majuscule, "WHILE") == 0))
874: {
875: niveau++;
876: }
877: else if (strcmp(instruction_majuscule, "END") == 0)
878: {
879: niveau--;
880: }
881:
882: free(instruction_majuscule);
883: free((*s_etat_processus).instruction_courante);
884: } while(drapeau_fin == d_faux);
885:
886: (*s_etat_processus).instruction_courante = tampon;
887: }
888: else
889: {
890: /*
891: * Vérification du pointeur de prédiction de saut
892: */
893:
894: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
895: .expression_courante).donnee).mutex)) != 0)
896: {
897: (*s_etat_processus).erreur_systeme = d_es_processus;
898: return;
899: }
900:
901: if ((*((struct_fonction *) (*(*(*s_etat_processus)
902: .expression_courante).donnee).objet)).prediction_saut
903: != NULL)
904: {
905: s_registre = (*s_etat_processus).expression_courante;
906:
907: (*s_etat_processus).expression_courante =
908: (struct_liste_chainee *)
909: (*((struct_fonction *) (*(*(*s_etat_processus)
910: .expression_courante).donnee).objet))
911: .prediction_saut;
912: fonction = (*((struct_fonction *)
913: (*(*(*s_etat_processus).expression_courante)
914: .donnee).objet)).fonction;
915: execution = (*((struct_fonction *)
916: (*(*s_registre).donnee).objet)).prediction_execution;
917:
918: if (pthread_mutex_unlock(&((*(*s_registre).donnee).mutex)) != 0)
919: {
920: (*s_etat_processus).erreur_systeme = d_es_processus;
921: return;
922: }
923:
924: if (execution == d_vrai)
925: {
926: fonction(s_etat_processus);
927: }
928: }
929: else
930: {
931: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
932: .expression_courante).donnee).mutex)) != 0)
933: {
934: (*s_etat_processus).erreur_systeme = d_es_processus;
935: return;
936: }
937:
938: s_registre = (*s_etat_processus).expression_courante;
939: execution = d_faux;
940:
941: do
942: {
943: if (((*s_etat_processus).expression_courante =
944: (*(*s_etat_processus).expression_courante).suivant)
945: == NULL)
946: {
947: (*s_etat_processus).erreur_execution =
948: d_ex_erreur_traitement_condition;
949: return;
950: }
951:
952: if ((*(*(*s_etat_processus).expression_courante)
953: .donnee).type == FCT)
954: {
955: fonction = (*((struct_fonction *)
956: (*(*(*s_etat_processus).expression_courante)
957: .donnee).objet)).fonction;
958:
959: if (niveau == 0)
960: {
961: if (fonction == instruction_end)
962: {
963: instruction_end(s_etat_processus);
964: execution = d_vrai;
965: drapeau_fin = d_vrai;
966: }
967: else
968: {
969: drapeau_fin = d_faux;
970: }
971: }
972: else
973: {
974: drapeau_fin = d_faux;
975: }
976:
977: if ((fonction == instruction_case) ||
978: (fonction == instruction_do) ||
979: (fonction == instruction_if) ||
980: (fonction == instruction_iferr) ||
981: (fonction == instruction_select) ||
982: (fonction == instruction_while))
983: {
984: niveau++;
985: }
986: else if (fonction == instruction_end)
987: {
988: niveau--;
989: }
990: }
991: } while(drapeau_fin == d_faux);
992:
993: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
994: .expression_courante).donnee).mutex)) != 0)
995: {
996: (*s_etat_processus).erreur_systeme = d_es_processus;
997: return;
998: }
999:
1000: (*((struct_fonction *) (*(*s_registre).donnee).objet))
1001: .prediction_saut = (*s_etat_processus)
1002: .expression_courante;
1003: (*((struct_fonction *) (*(*s_registre).donnee).objet))
1004: .prediction_execution = execution;
1005:
1006: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
1007: .expression_courante).donnee).mutex)) != 0)
1008: {
1009: (*s_etat_processus).erreur_systeme = d_es_processus;
1010: return;
1011: }
1012: }
1013: }
1014: }
1015: else
1016: {
1017: /*
1018: * On teste à nouveau...
1019: */
1020:
1021: (*(*s_etat_processus).l_base_pile_systeme).clause = 'I';
1022: }
1023:
1024: return;
1025: }
1026:
1027:
1028: /*
1029: ================================================================================
1030: Fonction 'e'
1031: ================================================================================
1032: Entrées : structure processus
1033: --------------------------------------------------------------------------------
1034: Sorties :
1035: --------------------------------------------------------------------------------
1036: Effets de bord : néant
1037: ================================================================================
1038: */
1039:
1040: void
1041: instruction_sensible_e(struct_processus *s_etat_processus)
1042: {
1043: if (strcmp((*s_etat_processus).instruction_courante, "e") == 0)
1044: {
1045: instruction_e(s_etat_processus);
1046: }
1047: else
1048: {
1049: (*s_etat_processus).instruction_valide = 'N';
1050: }
1051:
1052: return;
1053: }
1054:
1055: void
1056: instruction_e(struct_processus *s_etat_processus)
1057: {
1058: struct_objet *s_objet;
1059:
1060: (*s_etat_processus).erreur_execution = d_ex;
1061:
1062: if ((*s_etat_processus).affichage_arguments == 'Y')
1063: {
1064: printf("\n e ");
1065:
1066: if ((*s_etat_processus).langue == 'F')
1067: {
1068: printf("(base de logarithmes népériens)\n\n");
1069: }
1070: else
1071: {
1072: printf("(base of natural logarithm)\n\n");
1073: }
1074:
1075: printf("-> 1: %s\n", d_REL);
1076:
1077: return;
1078: }
1079: else if ((*s_etat_processus).test_instruction == 'Y')
1080: {
1081: (*s_etat_processus).constante_symbolique = 'Y';
1082: (*s_etat_processus).nombre_arguments = -1;
1083: return;
1084: }
1085:
1086: /* Indicateur 35 armé => évaluation symbolique */
1087: if (test_cfsf(s_etat_processus, 35) == d_vrai)
1088: {
1089: if ((s_objet = allocation(s_etat_processus, NOM)) == NULL)
1090: {
1091: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1092: return;
1093: }
1094:
1095: if (((*((struct_nom *) (*s_objet).objet)).nom =
1096: malloc(2 * sizeof(unsigned char))) == NULL)
1097: {
1098: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1099: return;
1100: }
1101:
1102: strcpy((*((struct_nom *) (*s_objet).objet)).nom, "e");
1103: (*((struct_nom *) (*s_objet).objet)).symbole = d_faux;
1104: }
1105: else
1106: {
1107: if ((s_objet = allocation(s_etat_processus, REL)) == NULL)
1108: {
1109: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1110: return;
1111: }
1112:
1113: (*((real8 *) (*s_objet).objet)) = exp((real8) 1);
1114: }
1115:
1116: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1117: s_objet) == d_erreur)
1118: {
1119: return;
1120: }
1121:
1122: return;
1123: }
1124:
1125:
1126: /*
1127: ================================================================================
1128: Fonction 'eng'
1129: ================================================================================
1130: Entrées : pointeur sur une struct_processus
1131: --------------------------------------------------------------------------------
1132: Sorties :
1133: --------------------------------------------------------------------------------
1134: Effets de bord : néant
1135: ================================================================================
1136: */
1137:
1138: void
1139: instruction_eng(struct_processus *s_etat_processus)
1140: {
1141: struct_objet *s_objet_argument;
1142: struct_objet *s_objet;
1143:
1144: logical1 i43;
1145: logical1 i44;
1146:
1147: unsigned char *valeur_binaire;
1148:
1149: unsigned long i;
1150: unsigned long j;
1151:
1152: (*s_etat_processus).erreur_execution = d_ex;
1153:
1154: if ((*s_etat_processus).affichage_arguments == 'Y')
1155: {
1156: printf("\n ENG ");
1157:
1158: if ((*s_etat_processus).langue == 'F')
1159: {
1160: printf("(notation ingénieur)\n\n");
1161: printf(" Aucun argument\n");
1162: }
1163: else
1164: {
1165: printf("(engineer notation)\n\n");
1166: printf(" No argument\n");
1167: }
1168:
1169: return;
1170: }
1171: else if ((*s_etat_processus).test_instruction == 'Y')
1172: {
1173: (*s_etat_processus).nombre_arguments = -1;
1174: return;
1175: }
1176:
1177: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1178: {
1179: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1180: {
1181: return;
1182: }
1183: }
1184:
1185: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1186: &s_objet_argument) == d_erreur)
1187: {
1188: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1189: return;
1190: }
1191:
1192: if ((*s_objet_argument).type == INT)
1193: {
1194: if (((*((integer8 *) (*s_objet_argument).objet)) >= 0) &&
1195: ((*((integer8 *) (*s_objet_argument).objet)) <= 15))
1196: {
1197: if ((s_objet = allocation(s_etat_processus, BIN)) == NULL)
1198: {
1199: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1200: return;
1201: }
1202:
1.43 bertrand 1203: (*((logical8 *) (*s_objet).objet)) = (logical8)
1.1 bertrand 1204: (*((integer8 *) (*s_objet_argument).objet));
1205:
1206: i43 = test_cfsf(s_etat_processus, 43);
1207: i44 = test_cfsf(s_etat_processus, 44);
1208:
1209: sf(s_etat_processus, 44);
1210: cf(s_etat_processus, 43);
1211:
1212: if ((valeur_binaire = formateur(s_etat_processus, 0, s_objet))
1213: == NULL)
1214: {
1215: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1216: return;
1217: }
1218:
1219: if (i43 == d_vrai)
1220: {
1221: sf(s_etat_processus, 43);
1222: }
1223: else
1224: {
1225: cf(s_etat_processus, 43);
1226: }
1227:
1228: if (i44 == d_vrai)
1229: {
1230: sf(s_etat_processus, 44);
1231: }
1232: else
1233: {
1234: cf(s_etat_processus, 44);
1235: }
1236:
1237: for(j = 53, i = strlen(valeur_binaire) - 2; i >= 2; i--)
1238: {
1239: if (valeur_binaire[i] == '0')
1240: {
1.43 bertrand 1241: cf(s_etat_processus, (unsigned char) j++);
1.1 bertrand 1242: }
1243: else
1244: {
1.43 bertrand 1245: sf(s_etat_processus, (unsigned char) j++);
1.1 bertrand 1246: }
1247: }
1248:
1.43 bertrand 1249: for(; j <= 56; cf(s_etat_processus, (unsigned char) j++));
1.1 bertrand 1250:
1251: sf(s_etat_processus, 49);
1252: sf(s_etat_processus, 50);
1253:
1254: free(valeur_binaire);
1255: liberation(s_etat_processus, s_objet);
1256: }
1257: else
1258: {
1259: liberation(s_etat_processus, s_objet_argument);
1260:
1261: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1262: return;
1263: }
1264: }
1265: else
1266: {
1267: liberation(s_etat_processus, s_objet_argument);
1268:
1269: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1270: return;
1271: }
1272:
1273: liberation(s_etat_processus, s_objet_argument);
1274:
1275: return;
1276: }
1277:
1278:
1279: /*
1280: ================================================================================
1281: Fonction 'exp'
1282: ================================================================================
1283: Entrées : pointeur sur une struct_processus
1284: --------------------------------------------------------------------------------
1285: Sorties :
1286: --------------------------------------------------------------------------------
1287: Effets de bord : néant
1288: ================================================================================
1289: */
1290:
1291: void
1292: instruction_exp(struct_processus *s_etat_processus)
1293: {
1294: struct_liste_chainee *l_element_courant;
1295: struct_liste_chainee *l_element_precedent;
1296:
1297: struct_objet *s_copie_argument;
1298: struct_objet *s_objet_argument;
1299: struct_objet *s_objet_resultat;
1300:
1301: (*s_etat_processus).erreur_execution = d_ex;
1302:
1303: if ((*s_etat_processus).affichage_arguments == 'Y')
1304: {
1305: printf("\n EXP ");
1306:
1307: if ((*s_etat_processus).langue == 'F')
1308: {
1309: printf("(exponentielle)\n\n");
1310: }
1311: else
1312: {
1313: printf("(exponential)\n\n");
1314: }
1315:
1316: printf(" 1: %s, %s\n", d_INT, d_REL);
1317: printf("-> 1: %s\n\n", d_REL);
1318:
1319: printf(" 1: %s\n", d_CPL);
1320: printf("-> 1: %s\n\n", d_CPL);
1321:
1322: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1323: printf("-> 1: %s\n\n", d_ALG);
1324:
1325: printf(" 1: %s\n", d_RPN);
1326: printf("-> 1: %s\n", d_RPN);
1327:
1328: return;
1329: }
1330: else if ((*s_etat_processus).test_instruction == 'Y')
1331: {
1332: (*s_etat_processus).nombre_arguments = 1;
1333: return;
1334: }
1335:
1336: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1337: {
1338: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1339: {
1340: return;
1341: }
1342: }
1343:
1344: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1345: &s_objet_argument) == d_erreur)
1346: {
1347: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1348: return;
1349: }
1350:
1351: /*
1352: --------------------------------------------------------------------------------
1353: Exponentielle d'un entier
1354: --------------------------------------------------------------------------------
1355: */
1356:
1357: if ((*s_objet_argument).type == INT)
1358: {
1359: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1360: {
1361: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1362: return;
1363: }
1364:
1365: (*((real8 *) (*s_objet_resultat).objet)) =
1366: exp((real8) (*((integer8 *) (*s_objet_argument).objet)));
1367: }
1368:
1369: /*
1370: --------------------------------------------------------------------------------
1371: Exponentielle d'un réel
1372: --------------------------------------------------------------------------------
1373: */
1374:
1375: else if ((*s_objet_argument).type == REL)
1376: {
1377: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1378: {
1379: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1380: return;
1381: }
1382:
1383: (*((real8 *) (*s_objet_resultat).objet)) =
1384: exp(((*((real8 *) (*s_objet_argument).objet))));
1385: }
1386:
1387: /*
1388: --------------------------------------------------------------------------------
1389: Exponentielle d'un complexe
1390: --------------------------------------------------------------------------------
1391: */
1392:
1393: else if ((*s_objet_argument).type == CPL)
1394: {
1395: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
1396: {
1397: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1398: return;
1399: }
1400:
1401: f77expc_((struct_complexe16 *) (*s_objet_argument).objet,
1402: (struct_complexe16 *) (*s_objet_resultat).objet);
1403: }
1404:
1405: /*
1406: --------------------------------------------------------------------------------
1407: Exponentielle d'un nom
1408: --------------------------------------------------------------------------------
1409: */
1410:
1411: else if ((*s_objet_argument).type == NOM)
1412: {
1413: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1414: {
1415: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1416: return;
1417: }
1418:
1419: if (((*s_objet_resultat).objet =
1420: allocation_maillon(s_etat_processus)) == NULL)
1421: {
1422: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1423: return;
1424: }
1425:
1426: l_element_courant = (*s_objet_resultat).objet;
1427:
1428: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1429: == NULL)
1430: {
1431: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1432: return;
1433: }
1434:
1435: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1436: .nombre_arguments = 0;
1437: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1438: .fonction = instruction_vers_niveau_superieur;
1439:
1440: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1441: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1442: {
1443: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1444: return;
1445: }
1446:
1447: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1448: .nom_fonction, "<<");
1449:
1450: if (((*l_element_courant).suivant =
1451: allocation_maillon(s_etat_processus)) == NULL)
1452: {
1453: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1454: return;
1455: }
1456:
1457: l_element_courant = (*l_element_courant).suivant;
1458: (*l_element_courant).donnee = s_objet_argument;
1459:
1460: if (((*l_element_courant).suivant =
1461: allocation_maillon(s_etat_processus)) == NULL)
1462: {
1463: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1464: return;
1465: }
1466:
1467: l_element_courant = (*l_element_courant).suivant;
1468:
1469: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1470: == NULL)
1471: {
1472: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1473: return;
1474: }
1475:
1476: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1477: .nombre_arguments = 1;
1478: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1479: .fonction = instruction_exp;
1480:
1481: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1482: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
1483: {
1484: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1485: return;
1486: }
1487:
1488: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1489: .nom_fonction, "EXP");
1490:
1491: if (((*l_element_courant).suivant =
1492: allocation_maillon(s_etat_processus)) == NULL)
1493: {
1494: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1495: return;
1496: }
1497:
1498: l_element_courant = (*l_element_courant).suivant;
1499:
1500: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1501: == NULL)
1502: {
1503: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1504: return;
1505: }
1506:
1507: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1508: .nombre_arguments = 0;
1509: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1510: .fonction = instruction_vers_niveau_inferieur;
1511:
1512: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1513: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1514: {
1515: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1516: return;
1517: }
1518:
1519: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1520: .nom_fonction, ">>");
1521:
1522: (*l_element_courant).suivant = NULL;
1523: s_objet_argument = NULL;
1524: }
1525:
1526: /*
1527: --------------------------------------------------------------------------------
1528: Exponentielle d'une expression
1529: --------------------------------------------------------------------------------
1530: */
1531:
1532: else if (((*s_objet_argument).type == ALG) ||
1533: ((*s_objet_argument).type == RPN))
1534: {
1535: if ((s_copie_argument = copie_objet(s_etat_processus,
1536: s_objet_argument, 'N')) == NULL)
1537: {
1538: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1539: return;
1540: }
1541:
1542: l_element_courant = (struct_liste_chainee *)
1543: (*s_copie_argument).objet;
1544: l_element_precedent = l_element_courant;
1545:
1546: while((*l_element_courant).suivant != NULL)
1547: {
1548: l_element_precedent = l_element_courant;
1549: l_element_courant = (*l_element_courant).suivant;
1550: }
1551:
1552: if (((*l_element_precedent).suivant =
1553: allocation_maillon(s_etat_processus)) == NULL)
1554: {
1555: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1556: return;
1557: }
1558:
1559: if (((*(*l_element_precedent).suivant).donnee =
1560: allocation(s_etat_processus, FCT)) == NULL)
1561: {
1562: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1563: return;
1564: }
1565:
1566: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1567: .donnee).objet)).nombre_arguments = 1;
1568: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1569: .donnee).objet)).fonction = instruction_exp;
1570:
1571: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1572: .suivant).donnee).objet)).nom_fonction =
1573: malloc(4 * sizeof(unsigned char))) == NULL)
1574: {
1575: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1576: return;
1577: }
1578:
1579: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1580: .suivant).donnee).objet)).nom_fonction, "EXP");
1581:
1582: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1583:
1584: s_objet_resultat = s_copie_argument;
1585: }
1586:
1587: /*
1588: --------------------------------------------------------------------------------
1589: Fonction exponentielle impossible à réaliser
1590: --------------------------------------------------------------------------------
1591: */
1592:
1593: else
1594: {
1595: liberation(s_etat_processus, s_objet_argument);
1596:
1597: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1598: return;
1599: }
1600:
1601: liberation(s_etat_processus, s_objet_argument);
1602:
1603: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1604: s_objet_resultat) == d_erreur)
1605: {
1606: return;
1607: }
1608:
1609: return;
1610: }
1611:
1612:
1613: /*
1614: ================================================================================
1615: Fonction 'exp' (-1)
1616: ================================================================================
1617: Entrées : pointeur sur une struct_processus
1618: --------------------------------------------------------------------------------
1619: Sorties :
1620: --------------------------------------------------------------------------------
1621: Effets de bord : néant
1622: ================================================================================
1623: */
1624:
1625: void
1626: instruction_expm(struct_processus *s_etat_processus)
1627: {
1628: struct_liste_chainee *l_element_courant;
1629: struct_liste_chainee *l_element_precedent;
1630:
1631: struct_objet *s_copie_argument;
1632: struct_objet *s_objet_argument;
1633: struct_objet *s_objet_resultat;
1634:
1635: (*s_etat_processus).erreur_execution = d_ex;
1636:
1637: if ((*s_etat_processus).affichage_arguments == 'Y')
1638: {
1639: printf("\n EXPM ");
1640:
1641: if ((*s_etat_processus).langue == 'F')
1642: {
1643: printf("(exponentielle moins un)\n\n");
1644: }
1645: else
1646: {
1647: printf("(exp - 1)\n\n");
1648: }
1649:
1650: printf(" 1: %s, %s\n", d_INT, d_REL);
1651: printf("-> 1: %s\n\n", d_REL);
1652:
1653: printf(" 1: %s\n", d_CPL);
1654: printf("-> 1: %s\n\n", d_CPL);
1655:
1656: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1657: printf("-> 1: %s\n\n", d_ALG);
1658:
1659: printf(" 1: %s\n", d_RPN);
1660: printf("-> 1: %s\n", d_RPN);
1661:
1662: return;
1663: }
1664: else if ((*s_etat_processus).test_instruction == 'Y')
1665: {
1666: (*s_etat_processus).nombre_arguments = 1;
1667: return;
1668: }
1669:
1670: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1671: {
1672: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1673: {
1674: return;
1675: }
1676: }
1677:
1678: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1679: &s_objet_argument) == d_erreur)
1680: {
1681: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1682: return;
1683: }
1684:
1685: /*
1686: --------------------------------------------------------------------------------
1687: Exponentielle (-1) d'un entier
1688: --------------------------------------------------------------------------------
1689: */
1690:
1691: if ((*s_objet_argument).type == INT)
1692: {
1693: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1694: {
1695: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1696: return;
1697: }
1698:
1699: (*((real8 *) (*s_objet_resultat).objet)) =
1700: expm1((real8) (*((integer8 *) (*s_objet_argument).objet)));
1701: }
1702:
1703: /*
1704: --------------------------------------------------------------------------------
1705: Exponentielle (-1) d'un réel
1706: --------------------------------------------------------------------------------
1707: */
1708:
1709: else if ((*s_objet_argument).type == REL)
1710: {
1711: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1712: {
1713: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1714: return;
1715: }
1716:
1717: (*((real8 *) (*s_objet_resultat).objet)) =
1718: expm1(((*((real8 *) (*s_objet_argument).objet))));
1719: }
1720:
1721: /*
1722: --------------------------------------------------------------------------------
1723: Exponentielle (-1) d'un nom
1724: --------------------------------------------------------------------------------
1725: */
1726:
1727: else if ((*s_objet_argument).type == NOM)
1728: {
1729: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1730: {
1731: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1732: return;
1733: }
1734:
1735: if (((*s_objet_resultat).objet =
1736: allocation_maillon(s_etat_processus)) == NULL)
1737: {
1738: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1739: return;
1740: }
1741:
1742: l_element_courant = (*s_objet_resultat).objet;
1743:
1744: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1745: == NULL)
1746: {
1747: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1748: return;
1749: }
1750:
1751: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1752: .nombre_arguments = 0;
1753: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1754: .fonction = instruction_vers_niveau_superieur;
1755:
1756: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1757: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1758: {
1759: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1760: return;
1761: }
1762:
1763: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1764: .nom_fonction, "<<");
1765:
1766: if (((*l_element_courant).suivant =
1767: allocation_maillon(s_etat_processus)) == NULL)
1768: {
1769: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1770: return;
1771: }
1772:
1773: l_element_courant = (*l_element_courant).suivant;
1774: (*l_element_courant).donnee = s_objet_argument;
1775:
1776: if (((*l_element_courant).suivant =
1777: allocation_maillon(s_etat_processus)) == NULL)
1778: {
1779: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1780: return;
1781: }
1782:
1783: l_element_courant = (*l_element_courant).suivant;
1784:
1785: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1786: == NULL)
1787: {
1788: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1789: return;
1790: }
1791:
1792: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1793: .nombre_arguments = 1;
1794: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1795: .fonction = instruction_expm;
1796:
1797: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1798: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
1799: {
1800: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1801: return;
1802: }
1803:
1804: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1805: .nom_fonction, "EXPM");
1806:
1807: if (((*l_element_courant).suivant =
1808: allocation_maillon(s_etat_processus)) == NULL)
1809: {
1810: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1811: return;
1812: }
1813:
1814: l_element_courant = (*l_element_courant).suivant;
1815:
1816: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1817: == NULL)
1818: {
1819: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1820: return;
1821: }
1822:
1823: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1824: .nombre_arguments = 0;
1825: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1826: .fonction = instruction_vers_niveau_inferieur;
1827:
1828: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1829: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1830: {
1831: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1832: return;
1833: }
1834:
1835: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1836: .nom_fonction, ">>");
1837:
1838: (*l_element_courant).suivant = NULL;
1839: s_objet_argument = NULL;
1840: }
1841:
1842: /*
1843: --------------------------------------------------------------------------------
1844: Exponentielle (-1) d'une expression
1845: --------------------------------------------------------------------------------
1846: */
1847:
1848: else if (((*s_objet_argument).type == ALG) ||
1849: ((*s_objet_argument).type == RPN))
1850: {
1851: if ((s_copie_argument = copie_objet(s_etat_processus,
1852: s_objet_argument, 'N')) == NULL)
1853: {
1854: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1855: return;
1856: }
1857:
1858: l_element_courant = (struct_liste_chainee *)
1859: (*s_copie_argument).objet;
1860: l_element_precedent = l_element_courant;
1861:
1862: while((*l_element_courant).suivant != NULL)
1863: {
1864: l_element_precedent = l_element_courant;
1865: l_element_courant = (*l_element_courant).suivant;
1866: }
1867:
1868: if (((*l_element_precedent).suivant =
1869: allocation_maillon(s_etat_processus)) == NULL)
1870: {
1871: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1872: return;
1873: }
1874:
1875: if (((*(*l_element_precedent).suivant).donnee =
1876: allocation(s_etat_processus, FCT)) == NULL)
1877: {
1878: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1879: return;
1880: }
1881:
1882: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1883: .donnee).objet)).nombre_arguments = 1;
1884: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1885: .donnee).objet)).fonction = instruction_expm;
1886:
1887: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1888: .suivant).donnee).objet)).nom_fonction =
1889: malloc(5 * sizeof(unsigned char))) == NULL)
1890: {
1891: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1892: return;
1893: }
1894:
1895: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1896: .suivant).donnee).objet)).nom_fonction, "EXPM");
1897:
1898: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1899:
1900: s_objet_resultat = s_copie_argument;
1901: }
1902:
1903: /*
1904: --------------------------------------------------------------------------------
1905: Fonction exponentielle (-1) impossible à réaliser
1906: --------------------------------------------------------------------------------
1907: */
1908:
1909: else
1910: {
1911: liberation(s_etat_processus, s_objet_argument);
1912:
1913: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1914: return;
1915: }
1916:
1917: liberation(s_etat_processus, s_objet_argument);
1918:
1919: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1920: s_objet_resultat) == d_erreur)
1921: {
1922: return;
1923: }
1924:
1925: return;
1926: }
1927:
1928: // vim: ts=4