1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.36
4: Copyright (C) 1989-2025 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
23: #include "rpl-conv.h"
24:
25:
26: /*
27: ================================================================================
28: Fonction 'abort'
29: ================================================================================
30: Entrées : pointeur sur une structure struct_processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_abort(struct_processus *s_etat_processus)
40: {
41: struct timespec attente;
42:
43: (*s_etat_processus).erreur_execution = d_ex;
44:
45: if ((*s_etat_processus).affichage_arguments == 'Y')
46: {
47: printf("\n ABORT ");
48:
49: if ((*s_etat_processus).langue == 'F')
50: {
51: printf("(abandon du programme)\n\n");
52: printf(" Aucun argument\n");
53: }
54: else
55: {
56: printf("(program abort)\n\n");
57: printf(" No argument\n");
58: }
59:
60: return;
61: }
62: else if ((*s_etat_processus).test_instruction == 'Y')
63: {
64: (*s_etat_processus).nombre_arguments = -1;
65: return;
66: }
67:
68: if (test_cfsf(s_etat_processus, 31) == d_vrai)
69: {
70: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
71: {
72: return;
73: }
74: }
75:
76: envoi_signal_processus((*s_etat_processus).pid_processus_pere,
77: rpl_sigabort, d_faux);
78: (*s_etat_processus).requete_arret = 'Y';
79:
80: attente.tv_sec = 0;
81: attente.tv_nsec = GRANULARITE_us * 1000;
82:
83: while((*s_etat_processus).var_volatile_requete_arret == 0)
84: {
85: scrutation_interruptions(s_etat_processus);
86: nanosleep(&attente, NULL);
87: INCR_GRANULARITE(attente.tv_nsec);
88: }
89:
90: if ((*s_etat_processus).traitement_instruction_halt == d_vrai)
91: {
92: (*s_etat_processus).execution_pas_suivant = d_vrai;
93: }
94:
95: return;
96: }
97:
98:
99: /*
100: ================================================================================
101: Fonction 'and'
102: ================================================================================
103: Entrées : pointeur sur une structure struct_processus
104: --------------------------------------------------------------------------------
105: Sorties :
106: --------------------------------------------------------------------------------
107: Effets de bord : néant
108: ================================================================================
109: */
110:
111: void
112: instruction_and(struct_processus *s_etat_processus)
113: {
114: struct_liste_chainee *l_element_courant;
115: struct_liste_chainee *l_element_precedent;
116:
117: struct_objet *s_copie_argument_1;
118: struct_objet *s_copie_argument_2;
119: struct_objet *s_objet_argument_1;
120: struct_objet *s_objet_argument_2;
121: struct_objet *s_objet_resultat;
122:
123: unsigned long nombre_elements;
124:
125: (*s_etat_processus).erreur_execution = d_ex;
126:
127: if ((*s_etat_processus).affichage_arguments == 'Y')
128: {
129: printf("\n AND ");
130:
131: if ((*s_etat_processus).langue == 'F')
132: {
133: printf("(opérateur et)\n\n");
134: }
135: else
136: {
137: printf("(and operator)\n\n");
138: }
139:
140: printf(" 2: %s, %s\n", d_INT, d_REL);
141: printf(" 1: %s, %s\n", d_INT, d_REL);
142: printf("-> 1: %s\n\n", d_INT);
143:
144: printf(" 2: %s\n", d_BIN);
145: printf(" 1: %s\n", d_BIN);
146: printf("-> 1: %s\n\n", d_BIN);
147:
148: printf(" 2: %s\n", d_NOM);
149: printf(" 1: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
150: printf("-> 1: %s\n\n", d_ALG);
151:
152: printf(" 2: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
153: printf(" 1: %s\n", d_NOM);
154: printf("-> 1: %s\n\n", d_ALG);
155:
156: printf(" 2: %s\n", d_ALG);
157: printf(" 1: %s\n", d_ALG);
158: printf("-> 1: %s\n\n", d_ALG);
159:
160: printf(" 2: %s\n", d_RPN);
161: printf(" 1: %s\n", d_RPN);
162: printf("-> 1: %s\n", d_RPN);
163:
164: return;
165: }
166: else if ((*s_etat_processus).test_instruction == 'Y')
167: {
168: (*s_etat_processus).nombre_arguments = 0;
169: return;
170: }
171:
172: if (test_cfsf(s_etat_processus, 31) == d_vrai)
173: {
174: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
175: {
176: return;
177: }
178: }
179:
180: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
181: &s_objet_argument_1) == d_erreur)
182: {
183: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
184: return;
185: }
186:
187: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
188: &s_objet_argument_2) == d_erreur)
189: {
190: liberation(s_etat_processus, s_objet_argument_1);
191:
192: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
193: return;
194: }
195:
196: /*
197: --------------------------------------------------------------------------------
198: AND logique
199: --------------------------------------------------------------------------------
200: */
201:
202: if (((((*s_objet_argument_1).type == INT) ||
203: ((*s_objet_argument_1).type == REL)) &&
204: (((*s_objet_argument_2).type == INT) ||
205: ((*s_objet_argument_2).type == REL))))
206: {
207: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
208: {
209: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
210: return;
211: }
212:
213: if ((*s_objet_argument_1).type == INT)
214: {
215: if ((*s_objet_argument_2).type == INT)
216: {
217: if (((*((integer8 *) (*s_objet_argument_1).objet)) != 0) &&
218: ((*((integer8 *) (*s_objet_argument_2).objet)) != 0))
219: {
220: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
221: }
222: else
223: {
224: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
225: }
226: }
227: else
228: {
229: if (((*((integer8 *) (*s_objet_argument_1).objet)) != 0) &&
230: ((*((real8 *) (*s_objet_argument_2).objet)) != 0))
231: {
232: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
233: }
234: else
235: {
236: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
237: }
238: }
239: }
240: else
241: {
242: if ((*s_objet_argument_2).type == INT)
243: {
244: if (((*((real8 *) (*s_objet_argument_1).objet)) != 0) &&
245: ((*((integer8 *) (*s_objet_argument_2).objet)) != 0))
246: {
247: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
248: }
249: else
250: {
251: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
252: }
253: }
254: else
255: {
256: if (((*((real8 *) (*s_objet_argument_1).objet)) != 0) &&
257: ((*((real8 *) (*s_objet_argument_2).objet)) != 0))
258: {
259: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
260: }
261: else
262: {
263: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
264: }
265: }
266: }
267: }
268:
269: /*
270: --------------------------------------------------------------------------------
271: AND binaire
272: --------------------------------------------------------------------------------
273: */
274:
275: else if (((*s_objet_argument_1).type == BIN) &&
276: ((*s_objet_argument_2).type == BIN))
277: {
278: if ((s_objet_resultat = allocation(s_etat_processus, BIN)) == NULL)
279: {
280: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
281: return;
282: }
283:
284: (*((logical8 *) (*s_objet_resultat).objet)) =
285: (*((logical8 *) (*s_objet_argument_1).objet)) &
286: (*((logical8 *) (*s_objet_argument_2).objet));
287: }
288:
289: /*
290: --------------------------------------------------------------------------------
291: AND entre des arguments complexes
292: --------------------------------------------------------------------------------
293: */
294:
295: /*
296: * Nom ou valeur numérique / Nom ou valeur numérique
297: */
298:
299: else if ((((*s_objet_argument_1).type == NOM) &&
300: (((*s_objet_argument_2).type == NOM) ||
301: ((*s_objet_argument_2).type == INT) ||
302: ((*s_objet_argument_2).type == REL))) ||
303: (((*s_objet_argument_2).type == NOM) &&
304: (((*s_objet_argument_1).type == INT) ||
305: ((*s_objet_argument_1).type == REL))))
306: {
307: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
308: {
309: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
310: return;
311: }
312:
313: if (((*s_objet_resultat).objet = allocation_maillon(s_etat_processus))
314: == NULL)
315: {
316: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
317: return;
318: }
319:
320: l_element_courant = (*s_objet_resultat).objet;
321:
322: if (((*l_element_courant).donnee =
323: allocation(s_etat_processus, FCT)) == NULL)
324: {
325: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
326: return;
327: }
328:
329: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
330: .nombre_arguments = 0;
331: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
332: .fonction = instruction_vers_niveau_superieur;
333:
334: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
335: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
336: {
337: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
338: return;
339: }
340:
341: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
342: .nom_fonction, "<<");
343:
344: if (((*l_element_courant).suivant =
345: allocation_maillon(s_etat_processus)) == NULL)
346: {
347: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
348: return;
349: }
350:
351: l_element_courant = (*l_element_courant).suivant;
352: (*l_element_courant).donnee = s_objet_argument_2;
353:
354: if (((*l_element_courant).suivant =
355: allocation_maillon(s_etat_processus)) == NULL)
356: {
357: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
358: return;
359: }
360:
361: l_element_courant = (*l_element_courant).suivant;
362: (*l_element_courant).donnee = s_objet_argument_1;
363:
364: if (((*l_element_courant).suivant =
365: allocation_maillon(s_etat_processus)) == NULL)
366: {
367: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
368: return;
369: }
370:
371: l_element_courant = (*l_element_courant).suivant;
372:
373: if (((*l_element_courant).donnee =
374: allocation(s_etat_processus, FCT)) == NULL)
375: {
376: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
377: return;
378: }
379:
380: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
381: .nombre_arguments = 0;
382: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
383: .fonction = instruction_and;
384:
385: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
386: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
387: {
388: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
389: return;
390: }
391:
392: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
393: .nom_fonction, "AND");
394:
395: if (((*l_element_courant).suivant =
396: allocation_maillon(s_etat_processus)) == NULL)
397: {
398: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
399: return;
400: }
401:
402: l_element_courant = (*l_element_courant).suivant;
403:
404: if (((*l_element_courant).donnee =
405: allocation(s_etat_processus, FCT)) == NULL)
406: {
407: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
408: return;
409: }
410:
411: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
412: .nombre_arguments = 0;
413: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
414: .fonction = instruction_vers_niveau_inferieur;
415:
416: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
417: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
418: {
419: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
420: return;
421: }
422:
423: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
424: .nom_fonction, ">>");
425:
426: (*l_element_courant).suivant = NULL;
427:
428: s_objet_argument_1 = NULL;
429: s_objet_argument_2 = NULL;
430: }
431:
432: /*
433: * Nom ou valeur numérique / Expression
434: */
435:
436: else if ((((*s_objet_argument_1).type == ALG) ||
437: ((*s_objet_argument_1).type == RPN)) &&
438: (((*s_objet_argument_2).type == NOM) ||
439: ((*s_objet_argument_2).type == INT) ||
440: ((*s_objet_argument_2).type == REL)))
441: {
442: nombre_elements = 0;
443: l_element_courant = (struct_liste_chainee *)
444: (*s_objet_argument_1).objet;
445:
446: while(l_element_courant != NULL)
447: {
448: nombre_elements++;
449: l_element_courant = (*l_element_courant).suivant;
450: }
451:
452: if (nombre_elements == 2)
453: {
454: liberation(s_etat_processus, s_objet_argument_1);
455: liberation(s_etat_processus, s_objet_argument_2);
456:
457: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
458: return;
459: }
460:
461: if ((s_objet_resultat = copie_objet(s_etat_processus,
462: s_objet_argument_1, 'N')) == NULL)
463: {
464: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
465: return;
466: }
467:
468: l_element_courant = (struct_liste_chainee *)
469: (*s_objet_resultat).objet;
470: l_element_precedent = l_element_courant;
471: l_element_courant = (*l_element_courant).suivant;
472:
473: if (((*l_element_precedent).suivant =
474: allocation_maillon(s_etat_processus)) == NULL)
475: {
476: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
477: return;
478: }
479:
480: (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
481: (*(*l_element_precedent).suivant).suivant = l_element_courant;
482:
483: while((*l_element_courant).suivant != NULL)
484: {
485: l_element_precedent = l_element_courant;
486: l_element_courant = (*l_element_courant).suivant;
487: }
488:
489: if (((*l_element_precedent).suivant =
490: allocation_maillon(s_etat_processus)) == NULL)
491: {
492: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
493: return;
494: }
495:
496: if (((*(*l_element_precedent).suivant).donnee =
497: allocation(s_etat_processus, FCT)) == NULL)
498: {
499: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
500: return;
501: }
502:
503: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
504: .donnee).objet)).nombre_arguments = 0;
505: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
506: .donnee).objet)).fonction = instruction_and;
507:
508: if (((*((struct_fonction *) (*(*(*l_element_precedent)
509: .suivant).donnee).objet)).nom_fonction =
510: malloc(4 * sizeof(unsigned char))) == NULL)
511: {
512: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
513: return;
514: }
515:
516: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
517: .suivant).donnee).objet)).nom_fonction, "AND");
518:
519: (*(*l_element_precedent).suivant).suivant = l_element_courant;
520:
521: s_objet_argument_2 = NULL;
522: }
523:
524: /*
525: * Expression / Nom ou valeur numérique
526: */
527:
528: else if ((((*s_objet_argument_1).type == NOM) ||
529: ((*s_objet_argument_1).type == INT) ||
530: ((*s_objet_argument_1).type == REL)) &&
531: (((*s_objet_argument_2).type == ALG) ||
532: ((*s_objet_argument_2).type == RPN)))
533: {
534: nombre_elements = 0;
535: l_element_courant = (struct_liste_chainee *)
536: (*s_objet_argument_2).objet;
537:
538: while(l_element_courant != NULL)
539: {
540: nombre_elements++;
541: l_element_courant = (*l_element_courant).suivant;
542: }
543:
544: if (nombre_elements == 2)
545: {
546: liberation(s_etat_processus, s_objet_argument_1);
547: liberation(s_etat_processus, s_objet_argument_2);
548:
549: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
550: return;
551: }
552:
553: if ((s_objet_resultat = copie_objet(s_etat_processus,
554: s_objet_argument_2, 'N')) == NULL)
555: {
556: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
557: return;
558: }
559:
560: l_element_courant = (struct_liste_chainee *)
561: (*s_objet_resultat).objet;
562: l_element_precedent = l_element_courant;
563:
564: while((*l_element_courant).suivant != NULL)
565: {
566: l_element_precedent = l_element_courant;
567: l_element_courant = (*l_element_courant).suivant;
568: }
569:
570: if (((*l_element_precedent).suivant =
571: allocation_maillon(s_etat_processus)) == NULL)
572: {
573: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
574: return;
575: }
576:
577: (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
578: l_element_precedent = (*l_element_precedent).suivant;
579:
580: if (((*l_element_precedent).suivant =
581: allocation_maillon(s_etat_processus)) == NULL)
582: {
583: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
584: return;
585: }
586:
587: if (((*(*l_element_precedent).suivant).donnee =
588: allocation(s_etat_processus, FCT)) == NULL)
589: {
590: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
591: return;
592: }
593:
594: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
595: .donnee).objet)).nombre_arguments = 0;
596: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
597: .donnee).objet)).fonction = instruction_and;
598:
599: if (((*((struct_fonction *) (*(*(*l_element_precedent)
600: .suivant).donnee).objet)).nom_fonction =
601: malloc(4 * sizeof(unsigned char))) == NULL)
602: {
603: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
604: return;
605: }
606:
607: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
608: .suivant).donnee).objet)).nom_fonction, "AND");
609:
610: (*(*l_element_precedent).suivant).suivant = l_element_courant;
611:
612: s_objet_argument_1 = NULL;
613: }
614:
615: /*
616: * Expression / Expression
617: */
618:
619: else if ((((*s_objet_argument_1).type == ALG) &&
620: ((*s_objet_argument_2).type == ALG)) ||
621: (((*s_objet_argument_1).type == RPN) &&
622: ((*s_objet_argument_2).type == RPN)))
623: {
624: nombre_elements = 0;
625: l_element_courant = (struct_liste_chainee *)
626: (*s_objet_argument_1).objet;
627:
628: while(l_element_courant != NULL)
629: {
630: nombre_elements++;
631: l_element_courant = (*l_element_courant).suivant;
632: }
633:
634: if (nombre_elements == 2)
635: {
636: liberation(s_etat_processus, s_objet_argument_1);
637: liberation(s_etat_processus, s_objet_argument_2);
638:
639: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
640: return;
641: }
642:
643: nombre_elements = 0;
644: l_element_courant = (struct_liste_chainee *)
645: (*s_objet_argument_2).objet;
646:
647: while(l_element_courant != NULL)
648: {
649: nombre_elements++;
650: l_element_courant = (*l_element_courant).suivant;
651: }
652:
653: if (nombre_elements == 2)
654: {
655: liberation(s_etat_processus, s_objet_argument_1);
656: liberation(s_etat_processus, s_objet_argument_2);
657:
658: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
659: return;
660: }
661:
662: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
663: s_objet_argument_1, 'N')) == NULL)
664: {
665: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
666: return;
667: }
668:
669: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
670: s_objet_argument_2, 'N')) == NULL)
671: {
672: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
673: return;
674: }
675:
676: l_element_courant = (struct_liste_chainee *)
677: (*s_copie_argument_1).objet;
678: (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
679: (*s_copie_argument_1).objet)).suivant;
680:
681: liberation(s_etat_processus, (*l_element_courant).donnee);
682: liberation_maillon(s_etat_processus, l_element_courant);
683:
684: l_element_courant = (struct_liste_chainee *)
685: (*s_copie_argument_2).objet;
686: l_element_precedent = l_element_courant;
687: s_objet_resultat = s_copie_argument_2;
688:
689: while((*l_element_courant).suivant != NULL)
690: {
691: l_element_precedent = l_element_courant;
692: l_element_courant = (*l_element_courant).suivant;
693: }
694:
695: liberation(s_etat_processus, (*l_element_courant).donnee);
696: liberation_maillon(s_etat_processus, l_element_courant);
697:
698: (*l_element_precedent).suivant = (struct_liste_chainee *)
699: (*s_copie_argument_1).objet;
700: (*s_copie_argument_1).objet = NULL;
701: free(s_copie_argument_1);
702:
703: l_element_courant = (*l_element_precedent).suivant;
704: while((*l_element_courant).suivant != NULL)
705: {
706: l_element_precedent = l_element_courant;
707: l_element_courant = (*l_element_courant).suivant;
708: }
709:
710: if (((*l_element_precedent).suivant =
711: allocation_maillon(s_etat_processus)) == NULL)
712: {
713: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
714: return;
715: }
716:
717: (*(*l_element_precedent).suivant).suivant = l_element_courant;
718: l_element_courant = (*l_element_precedent).suivant;
719:
720: if (((*l_element_courant).donnee =
721: allocation(s_etat_processus, FCT)) == NULL)
722: {
723: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
724: return;
725: }
726:
727: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
728: .nombre_arguments = 0;
729: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
730: .fonction = instruction_and;
731:
732: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
733: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
734: {
735: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
736: return;
737: }
738:
739: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
740: .nom_fonction, "AND");
741: }
742:
743: /*
744: --------------------------------------------------------------------------------
745: AND impossible
746: --------------------------------------------------------------------------------
747: */
748:
749: else
750: {
751: liberation(s_etat_processus, s_objet_argument_1);
752: liberation(s_etat_processus, s_objet_argument_2);
753:
754: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
755: return;
756: }
757:
758: liberation(s_etat_processus, s_objet_argument_1);
759: liberation(s_etat_processus, s_objet_argument_2);
760:
761: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
762: s_objet_resultat) == d_erreur)
763: {
764: return;
765: }
766:
767: return;
768: }
769:
770:
771: /*
772: ================================================================================
773: Fonction 'abs'
774: ================================================================================
775: Entrées :
776: --------------------------------------------------------------------------------
777: Sorties :
778: --------------------------------------------------------------------------------
779: Effets de bord : néant
780: ================================================================================
781: */
782:
783: void
784: instruction_abs(struct_processus *s_etat_processus)
785: {
786: logical1 erreur_memoire;
787:
788: real8 tampon_flottant;
789:
790: struct_liste_chainee *l_element_courant;
791: struct_liste_chainee *l_element_precedent;
792:
793: struct_objet *s_copie_argument;
794: struct_objet *s_objet_argument;
795: struct_objet *s_objet_resultat;
796:
797: integer8 i;
798: integer8 j;
799: integer8 k;
800: integer8 nombre_elements;
801:
802: void *accumulateur;
803:
804: (*s_etat_processus).erreur_execution = d_ex;
805:
806: if ((*s_etat_processus).affichage_arguments == 'Y')
807: {
808: printf("\n ABS ");
809:
810: if ((*s_etat_processus).langue == 'F')
811: {
812: printf("(norme)\n\n");
813: }
814: else
815: {
816: printf("(norm)\n\n");
817: }
818:
819: printf(" 1: %s\n", d_INT);
820: printf("-> 1: %s\n\n", d_INT);
821:
822: printf(" 1: %s, %s\n", d_REL, d_CPL);
823: printf("-> 1: %s\n\n", d_REL);
824:
825: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
826: printf("-> 1: %s\n\n", d_REL);
827:
828: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
829: printf("-> 1: %s\n\n", d_REL);
830:
831: printf(" 1: %s, %s\n", d_NOM, d_ALG);
832: printf("-> 1: %s\n\n", d_ALG);
833:
834: printf(" 1: %s\n", d_RPN);
835: printf("-> 1: %s\n", d_RPN);
836:
837: return;
838: }
839: else if ((*s_etat_processus).test_instruction == 'Y')
840: {
841: (*s_etat_processus).nombre_arguments = 1;
842: return;
843: }
844:
845: if (test_cfsf(s_etat_processus, 31) == d_vrai)
846: {
847: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
848: {
849: return;
850: }
851: }
852:
853: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
854: &s_objet_argument) == d_erreur)
855: {
856: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
857: return;
858: }
859:
860: /*
861: --------------------------------------------------------------------------------
862: Valeur absolue d'un entier
863: --------------------------------------------------------------------------------
864: */
865:
866: if ((*s_objet_argument).type == INT)
867: {
868: if ((*((integer8 *) (*s_objet_argument).objet)) != INT64_MIN)
869: {
870: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
871: {
872: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
873: return;
874: }
875:
876: (*((integer8 *) (*s_objet_resultat).objet)) = abs((*((integer8 *)
877: (*s_objet_argument).objet)));
878: }
879: else
880: {
881: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
882: {
883: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
884: return;
885: }
886:
887: (*((real8 *) (*s_objet_resultat).objet)) = abs((real8)
888: ((*((integer8 *) (*s_objet_argument).objet))));
889: }
890: }
891:
892: /*
893: --------------------------------------------------------------------------------
894: Valeur absolue d'un réel
895: --------------------------------------------------------------------------------
896: */
897:
898: else if ((*s_objet_argument).type == REL)
899: {
900: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
901: {
902: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
903: return;
904: }
905:
906: (*((real8 *) (*s_objet_resultat).objet)) = fabs(*((real8 *)
907: (*s_objet_argument).objet));
908: }
909:
910: /*
911: --------------------------------------------------------------------------------
912: Valeur absolue d'un complexe
913: --------------------------------------------------------------------------------
914: */
915:
916: else if ((*s_objet_argument).type == CPL)
917: {
918: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
919: {
920: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
921: return;
922: }
923:
924: (*s_objet_resultat).type = REL;
925: f77absc_(((struct_complexe16 *) (*s_objet_argument).objet),
926: ((real8 *) (*s_objet_resultat).objet));
927: }
928:
929: /*
930: --------------------------------------------------------------------------------
931: Norme de Frobenius d'un tableau
932: --------------------------------------------------------------------------------
933: */
934:
935: /*
936: * Vecteur d'entiers
937: */
938:
939: else if ((*s_objet_argument).type == VIN)
940: {
941: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
942: {
943: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
944: return;
945: }
946:
947: if ((accumulateur = malloc(((size_t) (*(((struct_vecteur *)
948: (*s_objet_argument).objet))).taille) * sizeof(real8))) == NULL)
949: {
950: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
951: return;
952: }
953:
954: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
955: .taille; i++)
956: {
957: ((real8 *) accumulateur)[i] = (real8) (((integer8 *)
958: (*((struct_vecteur *) (*s_objet_argument).objet))
959: .tableau)[i] * ((integer8 *) (*((struct_vecteur *)
960: (*s_objet_argument).objet)).tableau)[i]);
961: }
962:
963: (*((real8 *) (*s_objet_resultat).objet)) =
964: sqrt(sommation_vecteur_reel(accumulateur,
965: &((*(((struct_vecteur *) (*s_objet_argument).objet))).taille),
966: &erreur_memoire));
967:
968: if (erreur_memoire == d_vrai)
969: {
970: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
971: return;
972: }
973:
974: free(accumulateur);
975: }
976:
977: /*
978: * Vecteur de réels
979: */
980:
981: else if ((*s_objet_argument).type == VRL)
982: {
983: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
984: {
985: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
986: return;
987: }
988:
989: if ((accumulateur = malloc(((size_t) (*(((struct_vecteur *)
990: (*s_objet_argument).objet))).taille) * sizeof(real8))) == NULL)
991: {
992: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
993: return;
994: }
995:
996: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
997: .taille; i++)
998: {
999: ((real8 *) accumulateur)[i] = ((real8 *) (*((struct_vecteur *)
1000: (*s_objet_argument).objet)).tableau)[i] *
1001: ((real8 *) (*((struct_vecteur *)
1002: (*s_objet_argument).objet)).tableau)[i];
1003: }
1004:
1005: (*((real8 *) (*s_objet_resultat).objet)) =
1006: sqrt(sommation_vecteur_reel(accumulateur,
1007: &((*(((struct_vecteur *) (*s_objet_argument).objet))).taille),
1008: &erreur_memoire));
1009:
1010: if (erreur_memoire == d_vrai)
1011: {
1012: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1013: return;
1014: }
1015:
1016: free(accumulateur);
1017: }
1018:
1019: /*
1020: * Vecteur de complexes
1021: */
1022:
1023: else if ((*s_objet_argument).type == VCX)
1024: {
1025: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1026: {
1027: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1028: return;
1029: }
1030:
1031: if ((accumulateur = malloc(((size_t) (*(((struct_vecteur *)
1032: (*s_objet_argument).objet))).taille) * sizeof(real8))) == NULL)
1033: {
1034: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1035: return;
1036: }
1037:
1038: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
1039: .taille; i++)
1040: {
1041: f77absc_(&(((struct_complexe16 *) (*((struct_vecteur *)
1042: (*s_objet_argument).objet)).tableau)[i]), &tampon_flottant);
1043: ((real8 *) accumulateur)[i] = (tampon_flottant * tampon_flottant);
1044: }
1045:
1046: (*((real8 *) (*s_objet_resultat).objet)) =
1047: sqrt(sommation_vecteur_reel(accumulateur,
1048: &((*(((struct_vecteur *) (*s_objet_argument).objet))).taille),
1049: &erreur_memoire));
1050:
1051: if (erreur_memoire == d_vrai)
1052: {
1053: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1054: return;
1055: }
1056:
1057: free(accumulateur);
1058: }
1059:
1060: /*
1061: * Matrice d'entiers
1062: */
1063:
1064: else if ((*s_objet_argument).type == MIN)
1065: {
1066: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1067: {
1068: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1069: return;
1070: }
1071:
1072: if ((accumulateur = malloc(((size_t) (nombre_elements =
1073: (*(((struct_matrice *) (*s_objet_argument).objet)))
1074: .nombre_lignes * (*(((struct_matrice *) (*s_objet_argument)
1075: .objet))).nombre_colonnes)) * sizeof(real8))) == NULL)
1076: {
1077: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1078: return;
1079: }
1080:
1081: for(k = 0, i = 0; i < (*(((struct_matrice *)
1082: (*s_objet_argument).objet))).nombre_lignes; i++)
1083: {
1084: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
1085: .nombre_colonnes; j++)
1086: {
1087: ((real8 *) accumulateur)[k++] = (real8)
1088: (((integer8 **) (*((struct_matrice *)
1089: (*s_objet_argument).objet)).tableau)[i][j] *
1090: ((integer8 **) (*((struct_matrice *)
1091: (*s_objet_argument).objet)).tableau)[i][j]);
1092: }
1093: }
1094:
1095: (*((real8 *) (*s_objet_resultat).objet)) =
1096: sqrt(sommation_vecteur_reel(accumulateur, &nombre_elements,
1097: &erreur_memoire));
1098:
1099: if (erreur_memoire == d_vrai)
1100: {
1101: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1102: return;
1103: }
1104:
1105: free(accumulateur);
1106: }
1107:
1108: /*
1109: * Matrice de réels
1110: */
1111:
1112: else if ((*s_objet_argument).type == MRL)
1113: {
1114: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1115: {
1116: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1117: return;
1118: }
1119:
1120: if ((accumulateur = malloc(((size_t) (nombre_elements =
1121: (*(((struct_matrice *) (*s_objet_argument).objet)))
1122: .nombre_lignes * (*(((struct_matrice *) (*s_objet_argument)
1123: .objet))).nombre_colonnes)) * sizeof(real8))) == NULL)
1124: {
1125: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1126: return;
1127: }
1128:
1129: for(k = 0, i = 0; i < (*(((struct_matrice *)
1130: (*s_objet_argument).objet))).nombre_lignes; i++)
1131: {
1132: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
1133: .nombre_colonnes; j++)
1134: {
1135: ((real8 *) accumulateur)[k++] =
1136: ((real8 **) (*((struct_matrice *)
1137: (*s_objet_argument).objet)).tableau)[i][j] *
1138: ((real8 **) (*((struct_matrice *)
1139: (*s_objet_argument).objet)).tableau)[i][j];
1140: }
1141: }
1142:
1143: (*((real8 *) (*s_objet_resultat).objet)) =
1144: sqrt(sommation_vecteur_reel(accumulateur, &nombre_elements,
1145: &erreur_memoire));
1146:
1147: if (erreur_memoire == d_vrai)
1148: {
1149: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1150: return;
1151: }
1152:
1153: free(accumulateur);
1154: }
1155:
1156: /*
1157: * Matrice de complexes
1158: */
1159:
1160: else if ((*s_objet_argument).type == MCX)
1161: {
1162: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1163: {
1164: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1165: return;
1166: }
1167:
1168: if ((accumulateur = malloc(((size_t) (nombre_elements =
1169: (*(((struct_matrice *) (*s_objet_argument).objet)))
1170: .nombre_lignes * (*(((struct_matrice *) (*s_objet_argument)
1171: .objet))).nombre_colonnes)) * sizeof(real8))) == NULL)
1172: {
1173: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1174: return;
1175: }
1176:
1177: for(k = 0, i = 0; i < (*(((struct_matrice *)
1178: (*s_objet_argument).objet))).nombre_lignes; i++)
1179: {
1180: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
1181: .nombre_colonnes; j++)
1182: {
1183: f77absc_(&(((struct_complexe16 **) (*((struct_matrice *)
1184: (*s_objet_argument).objet)).tableau)[i][j]),
1185: &tampon_flottant);
1186: ((real8 *) accumulateur)[k++] =
1187: (tampon_flottant * tampon_flottant);
1188: }
1189: }
1190:
1191: (*((real8 *) (*s_objet_resultat).objet)) =
1192: sqrt(sommation_vecteur_reel(accumulateur, &nombre_elements,
1193: &erreur_memoire));
1194:
1195: if (erreur_memoire == d_vrai)
1196: {
1197: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1198: return;
1199: }
1200:
1201: free(accumulateur);
1202: }
1203:
1204: /*
1205: --------------------------------------------------------------------------------
1206: Valeur absolue d'un nom
1207: --------------------------------------------------------------------------------
1208: */
1209:
1210: else if ((*s_objet_argument).type == NOM)
1211: {
1212: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1213: {
1214: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1215: return;
1216: }
1217:
1218: if (((*s_objet_resultat).objet =
1219: allocation_maillon(s_etat_processus)) == NULL)
1220: {
1221: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1222: return;
1223: }
1224:
1225: l_element_courant = (*s_objet_resultat).objet;
1226:
1227: if (((*l_element_courant).donnee =
1228: allocation(s_etat_processus, FCT)) == NULL)
1229: {
1230: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1231: return;
1232: }
1233:
1234: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1235: .nombre_arguments = 0;
1236: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1237: .fonction = instruction_vers_niveau_superieur;
1238:
1239: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1240: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1241: {
1242: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1243: return;
1244: }
1245:
1246: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1247: .nom_fonction, "<<");
1248:
1249: if (((*l_element_courant).suivant =
1250: allocation_maillon(s_etat_processus)) == NULL)
1251: {
1252: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1253: return;
1254: }
1255:
1256: l_element_courant = (*l_element_courant).suivant;
1257: (*l_element_courant).donnee = s_objet_argument;
1258:
1259: if (((*l_element_courant).suivant =
1260: allocation_maillon(s_etat_processus)) == NULL)
1261: {
1262: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1263: return;
1264: }
1265:
1266: l_element_courant = (*l_element_courant).suivant;
1267:
1268: if (((*l_element_courant).donnee =
1269: allocation(s_etat_processus, FCT)) == NULL)
1270: {
1271: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1272: return;
1273: }
1274:
1275: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1276: .nombre_arguments = 1;
1277: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1278: .fonction = instruction_abs;
1279:
1280: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1281: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
1282: {
1283: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1284: return;
1285: }
1286:
1287: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1288: .nom_fonction, "ABS");
1289:
1290: if (((*l_element_courant).suivant =
1291: allocation_maillon(s_etat_processus)) == NULL)
1292: {
1293: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1294: return;
1295: }
1296:
1297: l_element_courant = (*l_element_courant).suivant;
1298:
1299: if (((*l_element_courant).donnee =
1300: allocation(s_etat_processus, FCT)) == NULL)
1301: {
1302: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1303: return;
1304: }
1305:
1306: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1307: .nombre_arguments = 0;
1308: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1309: .fonction = instruction_vers_niveau_inferieur;
1310:
1311: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1312: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1313: {
1314: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1315: return;
1316: }
1317:
1318: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1319: .nom_fonction, ">>");
1320:
1321: (*l_element_courant).suivant = NULL;
1322: s_objet_argument = NULL;
1323: }
1324:
1325: /*
1326: --------------------------------------------------------------------------------
1327: Valeur absolue d'une expression
1328: --------------------------------------------------------------------------------
1329: */
1330:
1331: else if (((*s_objet_argument).type == ALG) ||
1332: ((*s_objet_argument).type == RPN))
1333: {
1334: if ((s_copie_argument = copie_objet(s_etat_processus,
1335: s_objet_argument, 'N')) == NULL)
1336: {
1337: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1338: return;
1339: }
1340:
1341: l_element_courant = (struct_liste_chainee *)
1342: (*s_copie_argument).objet;
1343: l_element_precedent = l_element_courant;
1344:
1345: while((*l_element_courant).suivant != NULL)
1346: {
1347: l_element_precedent = l_element_courant;
1348: l_element_courant = (*l_element_courant).suivant;
1349: }
1350:
1351: if (((*l_element_precedent).suivant =
1352: allocation_maillon(s_etat_processus)) == NULL)
1353: {
1354: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1355: return;
1356: }
1357:
1358: if (((*(*l_element_precedent).suivant).donnee =
1359: allocation(s_etat_processus, FCT)) == NULL)
1360: {
1361: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1362: return;
1363: }
1364:
1365: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1366: .donnee).objet)).nombre_arguments = 1;
1367: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1368: .donnee).objet)).fonction = instruction_abs;
1369:
1370: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1371: .suivant).donnee).objet)).nom_fonction =
1372: malloc(4 * sizeof(unsigned char))) == NULL)
1373: {
1374: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1375: return;
1376: }
1377:
1378: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1379: .suivant).donnee).objet)).nom_fonction, "ABS");
1380:
1381: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1382:
1383: s_objet_resultat = s_copie_argument;
1384: }
1385:
1386: /*
1387: --------------------------------------------------------------------------------
1388: Valeur absolue impossible à réaliser
1389: --------------------------------------------------------------------------------
1390: */
1391:
1392: else
1393: {
1394: liberation(s_etat_processus, s_objet_argument);
1395:
1396: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1397: return;
1398: }
1399:
1400: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1401: s_objet_resultat) == d_erreur)
1402: {
1403: return;
1404: }
1405:
1406: liberation(s_etat_processus, s_objet_argument);
1407:
1408: return;
1409: }
1410:
1411:
1412: /*
1413: ================================================================================
1414: Fonction 'arg'
1415: ================================================================================
1416: Entrées : structure processus
1417: --------------------------------------------------------------------------------
1418: Sorties :
1419: --------------------------------------------------------------------------------
1420: Effets de bord : néant
1421: ================================================================================
1422: */
1423:
1424: void
1425: instruction_arg(struct_processus *s_etat_processus)
1426: {
1427: struct_liste_chainee *l_element_courant;
1428: struct_liste_chainee *l_element_precedent;
1429:
1430: struct_objet *s_copie_argument;
1431: struct_objet *s_objet_argument;
1432: struct_objet *s_objet_resultat;
1433:
1434: (*s_etat_processus).erreur_execution = d_ex;
1435:
1436: if ((*s_etat_processus).affichage_arguments == 'Y')
1437: {
1438: printf("\n ARG ");
1439:
1440: if ((*s_etat_processus).langue == 'F')
1441: {
1442: printf("(argument)\n\n");
1443: }
1444: else
1445: {
1446: printf("(argument)\n\n");
1447: }
1448:
1449: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
1450: printf("-> 1: %s\n\n", d_REL);
1451:
1452: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1453: printf("-> 1: %s\n\n", d_ALG);
1454:
1455: printf(" 1: %s\n", d_RPN);
1456: printf("-> 1: %s\n", d_RPN);
1457:
1458: return;
1459: }
1460: else if ((*s_etat_processus).test_instruction == 'Y')
1461: {
1462: (*s_etat_processus).nombre_arguments = 1;
1463: return;
1464: }
1465:
1466: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1467: {
1468: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1469: {
1470: return;
1471: }
1472: }
1473:
1474: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1475: &s_objet_argument) == d_erreur)
1476: {
1477: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1478: return;
1479: }
1480:
1481: /*
1482: --------------------------------------------------------------------------------
1483: Argument d'un entier ou d'un réel
1484: --------------------------------------------------------------------------------
1485: */
1486:
1487: if (((*s_objet_argument).type == INT) ||
1488: ((*s_objet_argument).type == REL))
1489: {
1490: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1491: == NULL)
1492: {
1493: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1494: return;
1495: }
1496:
1497: if ((*s_objet_argument).type == INT)
1498: {
1499: if ((*((integer8 *) (*s_objet_argument).objet)) >= 0)
1500: {
1501: (*((real8 *) (*s_objet_resultat).objet)) = 0;
1502: }
1503: else
1504: {
1505: (*((real8 *) (*s_objet_resultat).objet)) =
1506: 4 * atan((real8) 1);
1507: }
1508: }
1509: else
1510: {
1511: if ((*((real8 *) (*s_objet_argument).objet)) >= 0)
1512: {
1513: (*((real8 *) (*s_objet_resultat).objet)) = 0;
1514: }
1515: else
1516: {
1517: (*((real8 *) (*s_objet_resultat).objet)) =
1518: 4 * atan((real8) 1);
1519:
1520: if (test_cfsf(s_etat_processus, 60) == d_faux)
1521: {
1522: conversion_radians_vers_degres(&(*((real8 *)
1523: (*s_objet_resultat).objet)));
1524: }
1525: }
1526: }
1527: }
1528:
1529: /*
1530: --------------------------------------------------------------------------------
1531: Argument d'un complexe
1532: --------------------------------------------------------------------------------
1533: */
1534:
1535: else if ((*s_objet_argument).type == CPL)
1536: {
1537: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1538: == NULL)
1539: {
1540: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1541: return;
1542: }
1543:
1544: (*((real8 *) (*s_objet_resultat).objet)) =
1545: atan2((*((struct_complexe16 *) (*s_objet_argument).objet))
1546: .partie_imaginaire, (*((struct_complexe16 *)
1547: (*s_objet_argument).objet)).partie_reelle);
1548:
1549: if (test_cfsf(s_etat_processus, 60) == d_faux)
1550: {
1551: conversion_radians_vers_degres(&(*((real8 *)
1552: (*s_objet_resultat).objet)));
1553: }
1554: }
1555:
1556: /*
1557: --------------------------------------------------------------------------------
1558: Argument d'un nom
1559: --------------------------------------------------------------------------------
1560: */
1561:
1562: else if ((*s_objet_argument).type == NOM)
1563: {
1564: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
1565: == NULL)
1566: {
1567: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1568: return;
1569: }
1570:
1571: if (((*s_objet_resultat).objet =
1572: allocation_maillon(s_etat_processus)) == NULL)
1573: {
1574: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1575: return;
1576: }
1577:
1578: l_element_courant = (*s_objet_resultat).objet;
1579:
1580: if (((*l_element_courant).donnee =
1581: allocation(s_etat_processus, FCT)) == NULL)
1582: {
1583: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1584: return;
1585: }
1586:
1587: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1588: .nombre_arguments = 0;
1589: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1590: .fonction = instruction_vers_niveau_superieur;
1591:
1592: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1593: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1594: {
1595: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1596: return;
1597: }
1598:
1599: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1600: .nom_fonction, "<<");
1601:
1602: if (((*l_element_courant).suivant =
1603: allocation_maillon(s_etat_processus)) == NULL)
1604: {
1605: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1606: return;
1607: }
1608:
1609: l_element_courant = (*l_element_courant).suivant;
1610: (*l_element_courant).donnee = s_objet_argument;
1611:
1612: if (((*l_element_courant).suivant =
1613: allocation_maillon(s_etat_processus)) == NULL)
1614: {
1615: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1616: return;
1617: }
1618:
1619: l_element_courant = (*l_element_courant).suivant;
1620:
1621: if (((*l_element_courant).donnee =
1622: allocation(s_etat_processus, FCT)) == NULL)
1623: {
1624: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1625: return;
1626: }
1627:
1628: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1629: .nombre_arguments = 1;
1630: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1631: .fonction = instruction_arg;
1632:
1633: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1634: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
1635: {
1636: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1637: return;
1638: }
1639:
1640: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1641: .nom_fonction, "ARG");
1642:
1643: if (((*l_element_courant).suivant =
1644: allocation_maillon(s_etat_processus)) == NULL)
1645: {
1646: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1647: return;
1648: }
1649:
1650: l_element_courant = (*l_element_courant).suivant;
1651:
1652: if (((*l_element_courant).donnee =
1653: allocation(s_etat_processus, FCT)) == NULL)
1654: {
1655: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1656: return;
1657: }
1658:
1659: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1660: .nombre_arguments = 0;
1661: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1662: .fonction = instruction_vers_niveau_inferieur;
1663:
1664: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1665: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1666: {
1667: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1668: return;
1669: }
1670:
1671: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1672: .nom_fonction, ">>");
1673:
1674: (*l_element_courant).suivant = NULL;
1675: s_objet_argument = NULL;
1676: }
1677:
1678: /*
1679: --------------------------------------------------------------------------------
1680: Argument d'une expression
1681: --------------------------------------------------------------------------------
1682: */
1683:
1684: else if (((*s_objet_argument).type == ALG) ||
1685: ((*s_objet_argument).type == RPN))
1686: {
1687: if ((s_copie_argument = copie_objet(s_etat_processus,
1688: s_objet_argument, 'N')) == NULL)
1689: {
1690: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1691: return;
1692: }
1693:
1694: l_element_courant = (struct_liste_chainee *)
1695: (*s_copie_argument).objet;
1696: l_element_precedent = l_element_courant;
1697:
1698: while((*l_element_courant).suivant != NULL)
1699: {
1700: l_element_precedent = l_element_courant;
1701: l_element_courant = (*l_element_courant).suivant;
1702: }
1703:
1704: if (((*l_element_precedent).suivant =
1705: allocation_maillon(s_etat_processus)) == NULL)
1706: {
1707: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1708: return;
1709: }
1710:
1711: if (((*(*l_element_precedent).suivant).donnee =
1712: allocation(s_etat_processus, FCT)) == NULL)
1713: {
1714: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1715: return;
1716: }
1717:
1718: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1719: .donnee).objet)).nombre_arguments = 1;
1720: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1721: .donnee).objet)).fonction = instruction_arg;
1722:
1723: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1724: .suivant).donnee).objet)).nom_fonction =
1725: malloc(4 * sizeof(unsigned char))) == NULL)
1726: {
1727: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1728: return;
1729: }
1730:
1731: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1732: .suivant).donnee).objet)).nom_fonction, "ARG");
1733:
1734: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1735:
1736: s_objet_resultat = s_copie_argument;
1737: }
1738:
1739: /*
1740: --------------------------------------------------------------------------------
1741: Réalisation impossible de la fonction argument
1742: --------------------------------------------------------------------------------
1743: */
1744:
1745: else
1746: {
1747: liberation(s_etat_processus, s_objet_argument);
1748:
1749: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1750: return;
1751: }
1752:
1753: liberation(s_etat_processus, s_objet_argument);
1754:
1755: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1756: s_objet_resultat) == d_erreur)
1757: {
1758: return;
1759: }
1760:
1761: return;
1762: }
1763:
1764:
1765: /*
1766: ================================================================================
1767: Fonction 'asin'
1768: ================================================================================
1769: Entrées : pointeur sur une structure struct_processus
1770: --------------------------------------------------------------------------------
1771: Sorties :
1772: --------------------------------------------------------------------------------
1773: Effets de bord : néant
1774: ================================================================================
1775: */
1776:
1777: void
1778: instruction_asin(struct_processus *s_etat_processus)
1779: {
1780: real8 argument;
1781:
1782: struct_complexe16 registre;
1783:
1784: struct_liste_chainee *l_element_courant;
1785: struct_liste_chainee *l_element_precedent;
1786:
1787: struct_objet *s_copie_argument;
1788: struct_objet *s_objet_argument;
1789: struct_objet *s_objet_resultat;
1790:
1791: (*s_etat_processus).erreur_execution = d_ex;
1792:
1793: if ((*s_etat_processus).affichage_arguments == 'Y')
1794: {
1795: printf("\n ASIN ");
1796:
1797: if ((*s_etat_processus).langue == 'F')
1798: {
1799: printf("(arcsinus)\n\n");
1800: }
1801: else
1802: {
1803: printf("(arcsine)\n\n");
1804: }
1805:
1806: printf(" 1: %s, %s\n", d_INT, d_REL);
1807: printf("-> 1: %s, %s\n\n", d_REL, d_CPL);
1808:
1809: printf(" 1: %s\n", d_CPL);
1810: printf("-> 1: %s\n\n", d_CPL);
1811:
1812: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1813: printf("-> 1: %s\n\n", d_ALG);
1814:
1815: printf(" 1: %s\n", d_RPN);
1816: printf("-> 1: %s\n", d_RPN);
1817:
1818: return;
1819: }
1820: else if ((*s_etat_processus).test_instruction == 'Y')
1821: {
1822: (*s_etat_processus).nombre_arguments = 1;
1823: return;
1824: }
1825:
1826: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1827: {
1828: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1829: {
1830: return;
1831: }
1832: }
1833:
1834: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1835: &s_objet_argument) == d_erreur)
1836: {
1837: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1838: return;
1839: }
1840:
1841: /*
1842: --------------------------------------------------------------------------------
1843: Arcsinus d'un entier ou d'un réel
1844: --------------------------------------------------------------------------------
1845: */
1846:
1847: if (((*s_objet_argument).type == INT) ||
1848: ((*s_objet_argument).type == REL))
1849: {
1850: if ((*s_objet_argument).type == INT)
1851: {
1852: argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
1853: }
1854: else
1855: {
1856: argument = (*((real8 *) (*s_objet_argument).objet));
1857: }
1858:
1859: if ((argument >= -1) && (argument <= 1))
1860: {
1861: /*
1862: * Résultat réel
1863: */
1864:
1865: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1866: == NULL)
1867: {
1868: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1869: return;
1870: }
1871:
1872: (*((real8 *) (*s_objet_resultat).objet)) = asin(argument);
1873:
1874: if (test_cfsf(s_etat_processus, 60) == d_faux)
1875: {
1876: conversion_radians_vers_degres((real8 *)
1877: (*s_objet_resultat).objet);
1878: }
1879: }
1880: else
1881: {
1882: /*
1883: * Résultat complexe
1884: */
1885:
1886: registre.partie_reelle = argument;
1887: registre.partie_imaginaire = 0;
1888:
1889: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
1890: == NULL)
1891: {
1892: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1893: return;
1894: }
1895:
1896: f77asin_(®istre, (struct_complexe16 *)
1897: (*s_objet_resultat).objet);
1898: }
1899: }
1900:
1901: /*
1902: --------------------------------------------------------------------------------
1903: Arcsinus d'un complexe
1904: --------------------------------------------------------------------------------
1905: */
1906:
1907: else if ((*s_objet_argument).type == CPL)
1908: {
1909: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
1910: == NULL)
1911: {
1912: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1913: return;
1914: }
1915:
1916: f77asin_((struct_complexe16 *) (*s_objet_argument).objet,
1917: (struct_complexe16 *) (*s_objet_resultat).objet);
1918: }
1919:
1920: /*
1921: --------------------------------------------------------------------------------
1922: Arcsinus d'un nom
1923: --------------------------------------------------------------------------------
1924: */
1925:
1926: else if ((*s_objet_argument).type == NOM)
1927: {
1928: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
1929: == NULL)
1930: {
1931: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1932: return;
1933: }
1934:
1935: if (((*s_objet_resultat).objet =
1936: allocation_maillon(s_etat_processus)) == NULL)
1937: {
1938: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1939: return;
1940: }
1941:
1942: l_element_courant = (*s_objet_resultat).objet;
1943:
1944: if (((*l_element_courant).donnee =
1945: allocation(s_etat_processus, FCT)) == NULL)
1946: {
1947: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1948: return;
1949: }
1950:
1951: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1952: .nombre_arguments = 0;
1953: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1954: .fonction = instruction_vers_niveau_superieur;
1955:
1956: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1957: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1958: {
1959: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1960: return;
1961: }
1962:
1963: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1964: .nom_fonction, "<<");
1965:
1966: if (((*l_element_courant).suivant =
1967: allocation_maillon(s_etat_processus)) == NULL)
1968: {
1969: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1970: return;
1971: }
1972:
1973: l_element_courant = (*l_element_courant).suivant;
1974: (*l_element_courant).donnee = s_objet_argument;
1975:
1976: if (((*l_element_courant).suivant =
1977: allocation_maillon(s_etat_processus)) == NULL)
1978: {
1979: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1980: return;
1981: }
1982:
1983: l_element_courant = (*l_element_courant).suivant;
1984:
1985: if (((*l_element_courant).donnee =
1986: allocation(s_etat_processus, FCT)) == NULL)
1987: {
1988: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1989: return;
1990: }
1991:
1992: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1993: .nombre_arguments = 1;
1994: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1995: .fonction = instruction_asin;
1996:
1997: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1998: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
1999: {
2000: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2001: return;
2002: }
2003:
2004: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2005: .nom_fonction, "ASIN");
2006:
2007: if (((*l_element_courant).suivant =
2008: allocation_maillon(s_etat_processus)) == NULL)
2009: {
2010: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2011: return;
2012: }
2013:
2014: l_element_courant = (*l_element_courant).suivant;
2015:
2016: if (((*l_element_courant).donnee =
2017: allocation(s_etat_processus, FCT)) == NULL)
2018: {
2019: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2020: return;
2021: }
2022:
2023: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2024: .nombre_arguments = 0;
2025: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2026: .fonction = instruction_vers_niveau_inferieur;
2027:
2028: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2029: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2030: {
2031: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2032: return;
2033: }
2034:
2035: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2036: .nom_fonction, ">>");
2037:
2038: (*l_element_courant).suivant = NULL;
2039: s_objet_argument = NULL;
2040: }
2041:
2042: /*
2043: --------------------------------------------------------------------------------
2044: Arcsinus d'une expression
2045: --------------------------------------------------------------------------------
2046: */
2047:
2048: else if (((*s_objet_argument).type == ALG) ||
2049: ((*s_objet_argument).type == RPN))
2050: {
2051: if ((s_copie_argument = copie_objet(s_etat_processus,
2052: s_objet_argument, 'N')) == NULL)
2053: {
2054: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2055: return;
2056: }
2057:
2058: l_element_courant = (struct_liste_chainee *)
2059: (*s_copie_argument).objet;
2060: l_element_precedent = l_element_courant;
2061:
2062: while((*l_element_courant).suivant != NULL)
2063: {
2064: l_element_precedent = l_element_courant;
2065: l_element_courant = (*l_element_courant).suivant;
2066: }
2067:
2068: if (((*l_element_precedent).suivant =
2069: allocation_maillon(s_etat_processus)) == NULL)
2070: {
2071: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2072: return;
2073: }
2074:
2075: if (((*(*l_element_precedent).suivant).donnee =
2076: allocation(s_etat_processus, FCT)) == NULL)
2077: {
2078: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2079: return;
2080: }
2081:
2082: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2083: .donnee).objet)).nombre_arguments = 1;
2084: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2085: .donnee).objet)).fonction = instruction_asin;
2086:
2087: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2088: .suivant).donnee).objet)).nom_fonction =
2089: malloc(5 * sizeof(unsigned char))) == NULL)
2090: {
2091: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2092: return;
2093: }
2094:
2095: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2096: .suivant).donnee).objet)).nom_fonction, "ASIN");
2097:
2098: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2099:
2100: s_objet_resultat = s_copie_argument;
2101: }
2102:
2103: /*
2104: --------------------------------------------------------------------------------
2105: Réalisation impossible de la fonction arcsinus
2106: --------------------------------------------------------------------------------
2107: */
2108:
2109: else
2110: {
2111: liberation(s_etat_processus, s_objet_argument);
2112:
2113: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2114: return;
2115: }
2116:
2117: liberation(s_etat_processus, s_objet_argument);
2118:
2119: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2120: s_objet_resultat) == d_erreur)
2121: {
2122: return;
2123: }
2124:
2125: return;
2126: }
2127:
2128:
2129: /*
2130: ================================================================================
2131: Fonction 'acos'
2132: ================================================================================
2133: Entrées : pointeur sur une structure struct_processus
2134: --------------------------------------------------------------------------------
2135: Sorties :
2136: --------------------------------------------------------------------------------
2137: Effets de bord : néant
2138: ================================================================================
2139: */
2140:
2141: void
2142: instruction_acos(struct_processus *s_etat_processus)
2143: {
2144: real8 argument;
2145:
2146: struct_complexe16 registre;
2147:
2148: struct_liste_chainee *l_element_courant;
2149: struct_liste_chainee *l_element_precedent;
2150:
2151: struct_objet *s_copie_argument;
2152: struct_objet *s_objet_argument;
2153: struct_objet *s_objet_resultat;
2154:
2155: (*s_etat_processus).erreur_execution = d_ex;
2156:
2157: if ((*s_etat_processus).affichage_arguments == 'Y')
2158: {
2159: printf("\n ACOS ");
2160:
2161: if ((*s_etat_processus).langue == 'F')
2162: {
2163: printf("(arccosinus)\n\n");
2164: }
2165: else
2166: {
2167: printf("(arccosine)\n\n");
2168: }
2169:
2170: printf(" 1: %s, %s\n", d_INT, d_REL);
2171: printf("-> 1: %s, %s\n\n", d_REL, d_CPL);
2172:
2173: printf(" 1: %s\n", d_CPL);
2174: printf("-> 1: %s\n\n", d_CPL);
2175:
2176: printf(" 1: %s, %s\n", d_NOM, d_ALG);
2177: printf("-> 1: %s\n\n", d_ALG);
2178:
2179: printf(" 1: %s\n", d_RPN);
2180: printf("-> 1: %s\n", d_RPN);
2181:
2182: return;
2183: }
2184: else if ((*s_etat_processus).test_instruction == 'Y')
2185: {
2186: (*s_etat_processus).nombre_arguments = 1;
2187: return;
2188: }
2189:
2190: if (test_cfsf(s_etat_processus, 31) == d_vrai)
2191: {
2192: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
2193: {
2194: return;
2195: }
2196: }
2197:
2198: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2199: &s_objet_argument) == d_erreur)
2200: {
2201: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2202: return;
2203: }
2204:
2205: /*
2206: --------------------------------------------------------------------------------
2207: Arccossinus d'un entier ou d'un réel
2208: --------------------------------------------------------------------------------
2209: */
2210:
2211: if (((*s_objet_argument).type == INT) ||
2212: ((*s_objet_argument).type == REL))
2213: {
2214: if ((*s_objet_argument).type == INT)
2215: {
2216: argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
2217: }
2218: else
2219: {
2220: argument = (*((real8 *) (*s_objet_argument).objet));
2221: }
2222:
2223: if ((argument >= -1) && (argument <= 1))
2224: {
2225: /*
2226: * Résultat réel
2227: */
2228:
2229: if ((s_objet_resultat = allocation(s_etat_processus, REL))
2230: == NULL)
2231: {
2232: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2233: return;
2234: }
2235:
2236: (*((real8 *) (*s_objet_resultat).objet)) = acos(argument);
2237:
2238: if (test_cfsf(s_etat_processus, 60) == d_faux)
2239: {
2240: conversion_radians_vers_degres((real8 *)
2241: (*s_objet_resultat).objet);
2242: }
2243: }
2244: else
2245: {
2246: /*
2247: * Résultat complexe
2248: */
2249:
2250: registre.partie_reelle = argument;
2251: registre.partie_imaginaire = 0;
2252:
2253: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
2254: == NULL)
2255: {
2256: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2257: return;
2258: }
2259:
2260: f77acos_(®istre, (struct_complexe16 *)
2261: (*s_objet_resultat).objet);
2262: }
2263: }
2264:
2265: /*
2266: --------------------------------------------------------------------------------
2267: Arccossinus d'un complexe
2268: --------------------------------------------------------------------------------
2269: */
2270:
2271: else if ((*s_objet_argument).type == CPL)
2272: {
2273: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
2274: == NULL)
2275: {
2276: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2277: return;
2278: }
2279:
2280: f77acos_((struct_complexe16 *) (*s_objet_argument).objet,
2281: (struct_complexe16 *) (*s_objet_resultat).objet);
2282: }
2283:
2284: /*
2285: --------------------------------------------------------------------------------
2286: Arccossinus d'un nom
2287: --------------------------------------------------------------------------------
2288: */
2289:
2290: else if ((*s_objet_argument).type == NOM)
2291: {
2292: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
2293: == NULL)
2294: {
2295: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2296: return;
2297: }
2298:
2299: if (((*s_objet_resultat).objet =
2300: allocation_maillon(s_etat_processus)) == NULL)
2301: {
2302: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2303: return;
2304: }
2305:
2306: l_element_courant = (*s_objet_resultat).objet;
2307:
2308: if (((*l_element_courant).donnee =
2309: allocation(s_etat_processus, FCT)) == NULL)
2310: {
2311: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2312: return;
2313: }
2314:
2315: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2316: .nombre_arguments = 0;
2317: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2318: .fonction = instruction_vers_niveau_superieur;
2319:
2320: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2321: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2322: {
2323: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2324: return;
2325: }
2326:
2327: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2328: .nom_fonction, "<<");
2329:
2330: if (((*l_element_courant).suivant =
2331: allocation_maillon(s_etat_processus)) == NULL)
2332: {
2333: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2334: return;
2335: }
2336:
2337: l_element_courant = (*l_element_courant).suivant;
2338: (*l_element_courant).donnee = s_objet_argument;
2339:
2340: if (((*l_element_courant).suivant =
2341: allocation_maillon(s_etat_processus)) == NULL)
2342: {
2343: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2344: return;
2345: }
2346:
2347: l_element_courant = (*l_element_courant).suivant;
2348:
2349: if (((*l_element_courant).donnee =
2350: allocation(s_etat_processus, FCT)) == NULL)
2351: {
2352: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2353: return;
2354: }
2355:
2356: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2357: .nombre_arguments = 1;
2358: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2359: .fonction = instruction_acos;
2360:
2361: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2362: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
2363: {
2364: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2365: return;
2366: }
2367:
2368: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2369: .nom_fonction, "ACOS");
2370:
2371: if (((*l_element_courant).suivant =
2372: allocation_maillon(s_etat_processus)) == NULL)
2373: {
2374: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2375: return;
2376: }
2377:
2378: l_element_courant = (*l_element_courant).suivant;
2379:
2380: if (((*l_element_courant).donnee =
2381: allocation(s_etat_processus, FCT)) == NULL)
2382: {
2383: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2384: return;
2385: }
2386:
2387: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2388: .nombre_arguments = 0;
2389: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2390: .fonction = instruction_vers_niveau_inferieur;
2391:
2392: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2393: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2394: {
2395: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2396: return;
2397: }
2398:
2399: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2400: .nom_fonction, ">>");
2401:
2402: (*l_element_courant).suivant = NULL;
2403: s_objet_argument = NULL;
2404: }
2405:
2406: /*
2407: --------------------------------------------------------------------------------
2408: Arccossinus d'une expression
2409: --------------------------------------------------------------------------------
2410: */
2411:
2412: else if (((*s_objet_argument).type == ALG) ||
2413: ((*s_objet_argument).type == RPN))
2414: {
2415: if ((s_copie_argument = copie_objet(s_etat_processus,
2416: s_objet_argument, 'N')) == NULL)
2417: {
2418: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2419: return;
2420: }
2421:
2422: l_element_courant = (struct_liste_chainee *)
2423: (*s_copie_argument).objet;
2424: l_element_precedent = l_element_courant;
2425:
2426: while((*l_element_courant).suivant != NULL)
2427: {
2428: l_element_precedent = l_element_courant;
2429: l_element_courant = (*l_element_courant).suivant;
2430: }
2431:
2432: if (((*l_element_precedent).suivant =
2433: allocation_maillon(s_etat_processus)) == NULL)
2434: {
2435: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2436: return;
2437: }
2438:
2439: if (((*(*l_element_precedent).suivant).donnee =
2440: allocation(s_etat_processus, FCT)) == NULL)
2441: {
2442: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2443: return;
2444: }
2445:
2446: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2447: .donnee).objet)).nombre_arguments = 1;
2448: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2449: .donnee).objet)).fonction = instruction_acos;
2450:
2451: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2452: .suivant).donnee).objet)).nom_fonction =
2453: malloc(5 * sizeof(unsigned char))) == NULL)
2454: {
2455: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2456: return;
2457: }
2458:
2459: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2460: .suivant).donnee).objet)).nom_fonction, "ACOS");
2461:
2462: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2463:
2464: s_objet_resultat = s_copie_argument;
2465: }
2466:
2467: /*
2468: --------------------------------------------------------------------------------
2469: Réalisation impossible de la fonction arccosinus
2470: --------------------------------------------------------------------------------
2471: */
2472:
2473: else
2474: {
2475: liberation(s_etat_processus, s_objet_argument);
2476:
2477: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2478: return;
2479: }
2480:
2481: liberation(s_etat_processus, s_objet_argument);
2482:
2483: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2484: s_objet_resultat) == d_erreur)
2485: {
2486: return;
2487: }
2488:
2489: return;
2490: }
2491:
2492:
2493: /*
2494: ================================================================================
2495: Fonction 'atan'
2496: ================================================================================
2497: Entrées : pointeur sur une structure struct_processus
2498: --------------------------------------------------------------------------------
2499: Sorties :
2500: --------------------------------------------------------------------------------
2501: Effets de bord : néant
2502: ================================================================================
2503: */
2504:
2505: void
2506: instruction_atan(struct_processus *s_etat_processus)
2507: {
2508: real8 argument;
2509:
2510: integer4 erreur;
2511:
2512: struct_liste_chainee *l_element_courant;
2513: struct_liste_chainee *l_element_precedent;
2514:
2515: struct_objet *s_copie_argument;
2516: struct_objet *s_objet_argument;
2517: struct_objet *s_objet_resultat;
2518:
2519: (*s_etat_processus).erreur_execution = d_ex;
2520:
2521: if ((*s_etat_processus).affichage_arguments == 'Y')
2522: {
2523: printf("\n ATAN ");
2524:
2525: if ((*s_etat_processus).langue == 'F')
2526: {
2527: printf("(arctangente)\n\n");
2528: }
2529: else
2530: {
2531: printf("(arctangent)\n\n");
2532: }
2533:
2534: printf(" 1: %s, %s\n", d_INT, d_REL);
2535: printf("-> 1: %s, %s\n\n", d_REL, d_CPL);
2536:
2537: printf(" 1: %s\n", d_CPL);
2538: printf("-> 1: %s\n\n", d_CPL);
2539:
2540: printf(" 1: %s, %s\n", d_NOM, d_ALG);
2541: printf("-> 1: %s\n\n", d_ALG);
2542:
2543: printf(" 1: %s\n", d_RPN);
2544: printf("-> 1: %s\n", d_RPN);
2545:
2546: return;
2547: }
2548: else if ((*s_etat_processus).test_instruction == 'Y')
2549: {
2550: (*s_etat_processus).nombre_arguments = 1;
2551: return;
2552: }
2553:
2554: if (test_cfsf(s_etat_processus, 31) == d_vrai)
2555: {
2556: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
2557: {
2558: return;
2559: }
2560: }
2561:
2562: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2563: &s_objet_argument) == d_erreur)
2564: {
2565: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2566: return;
2567: }
2568:
2569: /*
2570: --------------------------------------------------------------------------------
2571: Arctangente d'un entier ou d'un réel
2572: --------------------------------------------------------------------------------
2573: */
2574:
2575: if (((*s_objet_argument).type == INT) ||
2576: ((*s_objet_argument).type == REL))
2577: {
2578: if ((*s_objet_argument).type == INT)
2579: {
2580: argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
2581: }
2582: else
2583: {
2584: argument = (*((real8 *) (*s_objet_argument).objet));
2585: }
2586:
2587: if ((s_objet_resultat = allocation(s_etat_processus, REL))
2588: == NULL)
2589: {
2590: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2591: return;
2592: }
2593:
2594: (*((real8 *) (*s_objet_resultat).objet)) = atan(argument);
2595:
2596: if (test_cfsf(s_etat_processus, 60) == d_faux)
2597: {
2598: conversion_radians_vers_degres((real8 *)
2599: (*s_objet_resultat).objet);
2600: }
2601: }
2602:
2603: /*
2604: --------------------------------------------------------------------------------
2605: Arctangente d'un complexe
2606: --------------------------------------------------------------------------------
2607: */
2608:
2609: else if ((*s_objet_argument).type == CPL)
2610: {
2611: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
2612: == NULL)
2613: {
2614: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2615: return;
2616: }
2617:
2618: f77atan_((struct_complexe16 *) (*s_objet_argument).objet,
2619: (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
2620:
2621: if (erreur != 0)
2622: {
2623: liberation(s_etat_processus, s_objet_argument);
2624: liberation(s_etat_processus, s_objet_resultat);
2625:
2626: free(s_objet_resultat);
2627:
2628: (*s_etat_processus).exception = d_ep_division_par_zero;
2629: return;
2630: }
2631: }
2632:
2633: /*
2634: --------------------------------------------------------------------------------
2635: Arctangente d'un nom
2636: --------------------------------------------------------------------------------
2637: */
2638:
2639: else if ((*s_objet_argument).type == NOM)
2640: {
2641: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
2642: == NULL)
2643: {
2644: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2645: return;
2646: }
2647:
2648: if (((*s_objet_resultat).objet =
2649: allocation_maillon(s_etat_processus)) == NULL)
2650: {
2651: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2652: return;
2653: }
2654:
2655: l_element_courant = (*s_objet_resultat).objet;
2656:
2657: if (((*l_element_courant).donnee =
2658: allocation(s_etat_processus, FCT)) == NULL)
2659: {
2660: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2661: return;
2662: }
2663:
2664: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2665: .nombre_arguments = 0;
2666: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2667: .fonction = instruction_vers_niveau_superieur;
2668:
2669: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2670: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2671: {
2672: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2673: return;
2674: }
2675:
2676: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2677: .nom_fonction, "<<");
2678:
2679: if (((*l_element_courant).suivant =
2680: allocation_maillon(s_etat_processus)) == NULL)
2681: {
2682: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2683: return;
2684: }
2685:
2686: l_element_courant = (*l_element_courant).suivant;
2687: (*l_element_courant).donnee = s_objet_argument;
2688:
2689: if (((*l_element_courant).suivant =
2690: allocation_maillon(s_etat_processus)) == NULL)
2691: {
2692: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2693: return;
2694: }
2695:
2696: l_element_courant = (*l_element_courant).suivant;
2697:
2698: if (((*l_element_courant).donnee =
2699: allocation(s_etat_processus, FCT)) == NULL)
2700: {
2701: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2702: return;
2703: }
2704:
2705: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2706: .nombre_arguments = 1;
2707: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2708: .fonction = instruction_atan;
2709:
2710: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2711: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
2712: {
2713: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2714: return;
2715: }
2716:
2717: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2718: .nom_fonction, "ATAN");
2719:
2720: if (((*l_element_courant).suivant =
2721: allocation_maillon(s_etat_processus)) == NULL)
2722: {
2723: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2724: return;
2725: }
2726:
2727: l_element_courant = (*l_element_courant).suivant;
2728:
2729: if (((*l_element_courant).donnee =
2730: allocation(s_etat_processus, FCT)) == NULL)
2731: {
2732: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2733: return;
2734: }
2735:
2736: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2737: .nombre_arguments = 0;
2738: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2739: .fonction = instruction_vers_niveau_inferieur;
2740:
2741: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2742: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2743: {
2744: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2745: return;
2746: }
2747:
2748: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2749: .nom_fonction, ">>");
2750:
2751: (*l_element_courant).suivant = NULL;
2752: s_objet_argument = NULL;
2753: }
2754:
2755: /*
2756: --------------------------------------------------------------------------------
2757: Arctangente d'une expression
2758: --------------------------------------------------------------------------------
2759: */
2760:
2761: else if (((*s_objet_argument).type == ALG) ||
2762: ((*s_objet_argument).type == RPN))
2763: {
2764: if ((s_copie_argument = copie_objet(s_etat_processus,
2765: s_objet_argument, 'N')) == NULL)
2766: {
2767: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2768: return;
2769: }
2770:
2771: l_element_courant = (struct_liste_chainee *)
2772: (*s_copie_argument).objet;
2773: l_element_precedent = l_element_courant;
2774:
2775: while((*l_element_courant).suivant != NULL)
2776: {
2777: l_element_precedent = l_element_courant;
2778: l_element_courant = (*l_element_courant).suivant;
2779: }
2780:
2781: if (((*l_element_precedent).suivant =
2782: allocation_maillon(s_etat_processus)) == NULL)
2783: {
2784: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2785: return;
2786: }
2787:
2788: if (((*(*l_element_precedent).suivant).donnee =
2789: allocation(s_etat_processus, FCT)) == NULL)
2790: {
2791: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2792: return;
2793: }
2794:
2795: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2796: .donnee).objet)).nombre_arguments = 1;
2797: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2798: .donnee).objet)).fonction = instruction_atan;
2799:
2800: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2801: .suivant).donnee).objet)).nom_fonction =
2802: malloc(5 * sizeof(unsigned char))) == NULL)
2803: {
2804: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2805: return;
2806: }
2807:
2808: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2809: .suivant).donnee).objet)).nom_fonction, "ATAN");
2810:
2811: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2812:
2813: s_objet_resultat = s_copie_argument;
2814: }
2815:
2816: /*
2817: --------------------------------------------------------------------------------
2818: Réalisation impossible de la fonction arctangente
2819: --------------------------------------------------------------------------------
2820: */
2821:
2822: else
2823: {
2824: liberation(s_etat_processus, s_objet_argument);
2825:
2826: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2827: return;
2828: }
2829:
2830: liberation(s_etat_processus, s_objet_argument);
2831:
2832: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2833: s_objet_resultat) == d_erreur)
2834: {
2835: return;
2836: }
2837:
2838: return;
2839: }
2840:
2841: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>