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