Annotation of rpl/src/instructions_a2.c, revision 1.68
1.1 bertrand 1: /*
2: ================================================================================
1.68 ! bertrand 3: RPL/2 (R) version 4.1.35
! 4: Copyright (C) 1989-2023 Dr. BERTRAND Joël
1.1 bertrand 5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
1.11 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 24:
25:
26: /*
27: ================================================================================
28: Fonction 'asinh'
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_asinh(struct_processus *s_etat_processus)
40: {
41: struct_liste_chainee *l_element_courant;
42: struct_liste_chainee *l_element_precedent;
43:
44: struct_objet *s_copie_argument;
45: struct_objet *s_objet_argument;
46: struct_objet *s_objet_resultat;
47:
48: (*s_etat_processus).erreur_execution = d_ex;
49:
50: if ((*s_etat_processus).affichage_arguments == 'Y')
51: {
52: printf("\n ASINH ");
53:
54: if ((*s_etat_processus).langue == 'F')
55: {
56: printf("(argument du sinus hyperbolique)\n\n");
57: }
58: else
59: {
60: printf("(hyperbolic sine argument)\n\n");
61: }
62:
63: printf(" 1: %s, %s\n", d_INT, d_REL);
64: printf("-> 1: %s\n\n", d_REL);
65:
66: printf(" 1: %s\n", d_CPL);
67: printf("-> 1: %s\n\n", d_CPL);
68:
69: printf(" 1: %s, %s\n", d_NOM, d_ALG);
70: printf("-> 1: %s\n\n", d_ALG);
71:
72: printf(" 1: %s\n", d_RPN);
73: printf("-> 1: %s\n", d_RPN);
74:
75: return;
76: }
77: else if ((*s_etat_processus).test_instruction == 'Y')
78: {
79: (*s_etat_processus).nombre_arguments = 1;
80: return;
81: }
82:
83: if (test_cfsf(s_etat_processus, 31) == d_vrai)
84: {
85: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
86: {
87: return;
88: }
89: }
90:
91: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
92: &s_objet_argument) == d_erreur)
93: {
94: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
95: return;
96: }
97:
98: /*
99: --------------------------------------------------------------------------------
100: Argsh d'un entier ou d'un réel
101: --------------------------------------------------------------------------------
102: */
103:
104: if (((*s_objet_argument).type == INT) ||
105: ((*s_objet_argument).type == REL))
106: {
107: if ((s_objet_resultat = allocation(s_etat_processus, REL))
108: == NULL)
109: {
110: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
111: return;
112: }
113:
114: if ((*s_objet_argument).type == INT)
115: {
116: f77asinhi_((integer8 *) (*s_objet_argument).objet,
117: (real8 *) (*s_objet_resultat).objet);
118: }
119: else
120: {
121: f77asinhr_((real8 *) (*s_objet_argument).objet,
122: (real8 *) (*s_objet_resultat).objet);
123: }
124: }
125:
126: /*
127: --------------------------------------------------------------------------------
128: Argsh d'un complexe
129: --------------------------------------------------------------------------------
130: */
131:
132: else if ((*s_objet_argument).type == CPL)
133: {
134: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
135: == NULL)
136: {
137: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
138: return;
139: }
140:
141: f77asinhc_((struct_complexe16 *) (*s_objet_argument).objet,
142: (struct_complexe16 *) (*s_objet_resultat).objet);
143: }
144:
145: /*
146: --------------------------------------------------------------------------------
147: Argsh d'un nom
148: --------------------------------------------------------------------------------
149: */
150:
151: else if ((*s_objet_argument).type == NOM)
152: {
153: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
154: == NULL)
155: {
156: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
157: return;
158: }
159:
160: if (((*s_objet_resultat).objet =
161: allocation_maillon(s_etat_processus)) == NULL)
162: {
163: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
164: return;
165: }
166:
167: l_element_courant = (*s_objet_resultat).objet;
168:
169: if (((*l_element_courant).donnee =
170: allocation(s_etat_processus, FCT)) == NULL)
171: {
172: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
173: return;
174: }
175:
176: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
177: .nombre_arguments = 0;
178: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
179: .fonction = instruction_vers_niveau_superieur;
180:
181: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
182: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
183: {
184: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
185: return;
186: }
187:
188: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
189: .nom_fonction, "<<");
190:
191: if (((*l_element_courant).suivant =
192: allocation_maillon(s_etat_processus)) == NULL)
193: {
194: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
195: return;
196: }
197:
198: l_element_courant = (*l_element_courant).suivant;
199: (*l_element_courant).donnee = s_objet_argument;
200:
201: if (((*l_element_courant).suivant =
202: allocation_maillon(s_etat_processus)) == NULL)
203: {
204: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
205: return;
206: }
207:
208: l_element_courant = (*l_element_courant).suivant;
209:
210: if (((*l_element_courant).donnee =
211: allocation(s_etat_processus, FCT)) == NULL)
212: {
213: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
214: return;
215: }
216:
217: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
218: .nombre_arguments = 1;
219: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
220: .fonction = instruction_asinh;
221:
222: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
223: .nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL)
224: {
225: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
226: return;
227: }
228:
229: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
230: .nom_fonction, "ASINH");
231:
232: if (((*l_element_courant).suivant =
233: allocation_maillon(s_etat_processus)) == NULL)
234: {
235: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
236: return;
237: }
238:
239: l_element_courant = (*l_element_courant).suivant;
240:
241: if (((*l_element_courant).donnee =
242: allocation(s_etat_processus, FCT)) == NULL)
243: {
244: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
245: return;
246: }
247:
248: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
249: .nombre_arguments = 0;
250: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
251: .fonction = instruction_vers_niveau_inferieur;
252:
253: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
254: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
255: {
256: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
257: return;
258: }
259:
260: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
261: .nom_fonction, ">>");
262:
263: (*l_element_courant).suivant = NULL;
264: s_objet_argument = NULL;
265: }
266:
267: /*
268: --------------------------------------------------------------------------------
269: Argsh d'une expression
270: --------------------------------------------------------------------------------
271: */
272:
273: else if (((*s_objet_argument).type == ALG) ||
274: ((*s_objet_argument).type == RPN))
275: {
276: if ((s_copie_argument = copie_objet(s_etat_processus,
277: s_objet_argument, 'N')) == NULL)
278: {
279: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
280: return;
281: }
282:
283: l_element_courant = (struct_liste_chainee *)
284: (*s_copie_argument).objet;
285: l_element_precedent = l_element_courant;
286:
287: while((*l_element_courant).suivant != NULL)
288: {
289: l_element_precedent = l_element_courant;
290: l_element_courant = (*l_element_courant).suivant;
291: }
292:
293: if (((*l_element_precedent).suivant =
294: allocation_maillon(s_etat_processus)) == NULL)
295: {
296: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
297: return;
298: }
299:
300: if (((*(*l_element_precedent).suivant).donnee =
301: allocation(s_etat_processus, FCT)) == NULL)
302: {
303: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
304: return;
305: }
306:
307: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
308: .donnee).objet)).nombre_arguments = 1;
309: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
310: .donnee).objet)).fonction = instruction_asinh;
311:
312: if (((*((struct_fonction *) (*(*(*l_element_precedent)
313: .suivant).donnee).objet)).nom_fonction =
314: malloc(6 * sizeof(unsigned char))) == NULL)
315: {
316: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
317: return;
318: }
319:
320: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
321: .suivant).donnee).objet)).nom_fonction, "ASINH");
322:
323: (*(*l_element_precedent).suivant).suivant = l_element_courant;
324:
325: s_objet_resultat = s_copie_argument;
326: }
327:
328: /*
329: --------------------------------------------------------------------------------
330: Réalisation impossible de la fonction argsh
331: --------------------------------------------------------------------------------
332: */
333:
334: else
335: {
336: liberation(s_etat_processus, s_objet_argument);
337:
338: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
339: return;
340: }
341:
342: liberation(s_etat_processus, s_objet_argument);
343:
344: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
345: s_objet_resultat) == d_erreur)
346: {
347: return;
348: }
349:
350: return;
351: }
352:
353:
354: /*
355: ================================================================================
356: Fonction 'acosh'
357: ================================================================================
358: Entrées : pointeur sur une structure struct_processus
359: --------------------------------------------------------------------------------
360: Sorties :
361: --------------------------------------------------------------------------------
362: Effets de bord : néant
363: ================================================================================
364: */
365:
366: void
367: instruction_acosh(struct_processus *s_etat_processus)
368: {
369: real8 argument;
370:
371: struct_complexe16 registre;
372:
373: struct_liste_chainee *l_element_courant;
374: struct_liste_chainee *l_element_precedent;
375:
376: struct_objet *s_copie_argument;
377: struct_objet *s_objet_argument;
378: struct_objet *s_objet_resultat;
379:
380: (*s_etat_processus).erreur_execution = d_ex;
381:
382: if ((*s_etat_processus).affichage_arguments == 'Y')
383: {
384: printf("\n ACOSH ");
385:
386: if ((*s_etat_processus).langue == 'F')
387: {
388: printf("(argument du cosinus hyperbolique)\n\n");
389: }
390: else
391: {
392: printf("(hyperbolic cosine argument)\n\n");
393: }
394:
395: printf(" 1: %s, %s\n", d_INT, d_REL);
396: printf("-> 1: %s\n\n", d_REL);
397:
398: printf(" 1: %s\n", d_CPL);
399: printf("-> 1: %s\n\n", d_CPL);
400:
401: printf(" 1: %s, %s\n", d_NOM, d_ALG);
402: printf("-> 1: %s\n\n", d_ALG);
403:
404: printf(" 1: %s\n", d_RPN);
405: printf("-> 1: %s\n", d_RPN);
406:
407: return;
408: }
409: else if ((*s_etat_processus).test_instruction == 'Y')
410: {
411: (*s_etat_processus).nombre_arguments = 1;
412: return;
413: }
414:
415: if (test_cfsf(s_etat_processus, 31) == d_vrai)
416: {
417: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
418: {
419: return;
420: }
421: }
422:
423: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
424: &s_objet_argument) == d_erreur)
425: {
426: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
427: return;
428: }
429:
430: /*
431: --------------------------------------------------------------------------------
432: Argch d'un entier ou d'un réel
433: --------------------------------------------------------------------------------
434: */
435:
436: if (((*s_objet_argument).type == INT) ||
437: ((*s_objet_argument).type == REL))
438: {
439: if ((*s_objet_argument).type == INT)
440: {
1.41 bertrand 441: argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
1.1 bertrand 442: }
443: else
444: {
445: argument = (*((real8 *) (*s_objet_argument).objet));
446: }
447:
448: if (argument >= 1)
449: {
450: if ((s_objet_resultat = allocation(s_etat_processus, REL))
451: == NULL)
452: {
453: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
454: return;
455: }
456:
457: if ((*s_objet_argument).type == INT)
458: {
459: f77acoshi_((integer8 *) (*s_objet_argument).objet,
460: (real8 *) (*s_objet_resultat).objet);
461: }
462: else
463: {
464: f77acoshr_((real8 *) (*s_objet_argument).objet,
465: (real8 *) (*s_objet_resultat).objet);
466: }
467: }
468: else
469: {
470: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
471: == NULL)
472: {
473: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
474: return;
475: }
476:
477: if ((*s_objet_argument).type == INT)
478: {
479: registre.partie_reelle = (real8) (*((integer8 *)
480: (*s_objet_argument).objet));
481: }
482: else
483: {
484: registre.partie_reelle = (*((real8 *)
485: (*s_objet_argument).objet));
486: }
487:
488: registre.partie_imaginaire = 0;
489:
490: f77acoshc_(®istre, (struct_complexe16 *)
491: (*s_objet_resultat).objet);
492: }
493: }
494:
495: /*
496: --------------------------------------------------------------------------------
497: Argch d'un complexe
498: --------------------------------------------------------------------------------
499: */
500:
501: else if ((*s_objet_argument).type == CPL)
502: {
503: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
504: == NULL)
505: {
506: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
507: return;
508: }
509:
510: f77acoshc_((struct_complexe16 *) (*s_objet_argument).objet,
511: (struct_complexe16 *) (*s_objet_resultat).objet);
512: }
513:
514: /*
515: --------------------------------------------------------------------------------
516: Argch d'un nom
517: --------------------------------------------------------------------------------
518: */
519:
520: else if ((*s_objet_argument).type == NOM)
521: {
522: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
523: == NULL)
524: {
525: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
526: return;
527: }
528:
529: if (((*s_objet_resultat).objet =
530: allocation_maillon(s_etat_processus)) == NULL)
531: {
532: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
533: return;
534: }
535:
536: l_element_courant = (*s_objet_resultat).objet;
537:
538: if (((*l_element_courant).donnee =
539: allocation(s_etat_processus, FCT)) == NULL)
540: {
541: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
542: return;
543: }
544:
545: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
546: .nombre_arguments = 0;
547: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
548: .fonction = instruction_vers_niveau_superieur;
549:
550: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
551: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
552: {
553: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
554: return;
555: }
556:
557: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
558: .nom_fonction, "<<");
559:
560: if (((*l_element_courant).suivant =
561: allocation_maillon(s_etat_processus)) == NULL)
562: {
563: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
564: return;
565: }
566:
567: l_element_courant = (*l_element_courant).suivant;
568: (*l_element_courant).donnee = s_objet_argument;
569:
570: if (((*l_element_courant).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_courant = (*l_element_courant).suivant;
578:
579: if (((*l_element_courant).donnee =
580: allocation(s_etat_processus, FCT)) == NULL)
581: {
582: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
583: return;
584: }
585:
586: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
587: .nombre_arguments = 1;
588: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
589: .fonction = instruction_acosh;
590:
591: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
592: .nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL)
593: {
594: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
595: return;
596: }
597:
598: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
599: .nom_fonction, "ACOSH");
600:
601: if (((*l_element_courant).suivant =
602: allocation_maillon(s_etat_processus)) == NULL)
603: {
604: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
605: return;
606: }
607:
608: l_element_courant = (*l_element_courant).suivant;
609:
610: if (((*l_element_courant).donnee =
611: allocation(s_etat_processus, FCT)) == NULL)
612: {
613: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
614: return;
615: }
616:
617: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
618: .nombre_arguments = 0;
619: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
620: .fonction = instruction_vers_niveau_inferieur;
621:
622: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
623: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
624: {
625: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
626: return;
627: }
628:
629: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
630: .nom_fonction, ">>");
631:
632: (*l_element_courant).suivant = NULL;
633: s_objet_argument = NULL;
634: }
635:
636: /*
637: --------------------------------------------------------------------------------
638: Argch d'une expression
639: --------------------------------------------------------------------------------
640: */
641:
642: else if (((*s_objet_argument).type == ALG) ||
643: ((*s_objet_argument).type == RPN))
644: {
645: if ((s_copie_argument = copie_objet(s_etat_processus,
646: s_objet_argument, 'N')) == NULL)
647: {
648: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
649: return;
650: }
651:
652: l_element_courant = (struct_liste_chainee *)
653: (*s_copie_argument).objet;
654: l_element_precedent = l_element_courant;
655:
656: while((*l_element_courant).suivant != NULL)
657: {
658: l_element_precedent = l_element_courant;
659: l_element_courant = (*l_element_courant).suivant;
660: }
661:
662: if (((*l_element_precedent).suivant =
663: allocation_maillon(s_etat_processus)) == NULL)
664: {
665: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
666: return;
667: }
668:
669: if (((*(*l_element_precedent).suivant).donnee =
670: allocation(s_etat_processus, FCT)) == NULL)
671: {
672: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
673: return;
674: }
675:
676: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
677: .donnee).objet)).nombre_arguments = 1;
678: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
679: .donnee).objet)).fonction = instruction_acosh;
680:
681: if (((*((struct_fonction *) (*(*(*l_element_precedent)
682: .suivant).donnee).objet)).nom_fonction =
683: malloc(6 * sizeof(unsigned char))) == NULL)
684: {
685: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
686: return;
687: }
688:
689: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
690: .suivant).donnee).objet)).nom_fonction, "ACOSH");
691:
692: (*(*l_element_precedent).suivant).suivant = l_element_courant;
693:
694: s_objet_resultat = s_copie_argument;
695: }
696:
697: /*
698: --------------------------------------------------------------------------------
699: Réalisation impossible de la fonction argch
700: --------------------------------------------------------------------------------
701: */
702:
703: else
704: {
705: liberation(s_etat_processus, s_objet_argument);
706:
707: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
708: return;
709: }
710:
711: liberation(s_etat_processus, s_objet_argument);
712:
713: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
714: s_objet_resultat) == d_erreur)
715: {
716: return;
717: }
718:
719: return;
720: }
721:
722:
723: /*
724: ================================================================================
725: Fonction 'atanh'
726: ================================================================================
727: Entrées : pointeur sur une structure struct_processus
728: --------------------------------------------------------------------------------
729: Sorties :
730: --------------------------------------------------------------------------------
731: Effets de bord : néant
732: ================================================================================
733: */
734:
735: void
736: instruction_atanh(struct_processus *s_etat_processus)
737: {
738: real8 argument;
739:
740: struct_complexe16 registre;
741:
742: struct_liste_chainee *l_element_courant;
743: struct_liste_chainee *l_element_precedent;
744:
745: struct_objet *s_copie_argument;
746: struct_objet *s_objet_argument;
747: struct_objet *s_objet_resultat;
748:
749: (*s_etat_processus).erreur_execution = d_ex;
750:
751: if ((*s_etat_processus).affichage_arguments == 'Y')
752: {
753: printf("\n ATANH ");
754:
755: if ((*s_etat_processus).langue == 'F')
756: {
757: printf("(argument de la tangente hyperbolique)\n\n");
758: }
759: else
760: {
761: printf("(hyperbolic tangent argument)\n\n");
762: }
763:
764: printf(" 1: %s, %s\n", d_INT, d_REL);
765: printf("-> 1: %s\n\n", d_REL);
766:
767: printf(" 1: %s\n", d_CPL);
768: printf("-> 1: %s\n\n", d_CPL);
769:
770: printf(" 1: %s, %s\n", d_NOM, d_ALG);
771: printf("-> 1: %s\n\n", d_ALG);
772:
773: printf(" 1: %s\n", d_RPN);
774: printf("-> 1: %s\n", d_RPN);
775:
776: return;
777: }
778: else if ((*s_etat_processus).test_instruction == 'Y')
779: {
780: (*s_etat_processus).nombre_arguments = 1;
781: return;
782: }
783:
784: if (test_cfsf(s_etat_processus, 31) == d_vrai)
785: {
786: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
787: {
788: return;
789: }
790: }
791:
792: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
793: &s_objet_argument) == d_erreur)
794: {
795: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
796: return;
797: }
798:
799: /*
800: --------------------------------------------------------------------------------
801: Argth d'un entier ou d'un réel
802: --------------------------------------------------------------------------------
803: */
804:
805: if (((*s_objet_argument).type == INT) ||
806: ((*s_objet_argument).type == REL))
807: {
808: if ((*s_objet_argument).type == INT)
809: {
1.41 bertrand 810: argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
1.1 bertrand 811: }
812: else
813: {
814: argument = (*((real8 *) (*s_objet_argument).objet));
815: }
816:
817: if ((argument < 1) && (argument > -1))
818: {
819: if ((s_objet_resultat = allocation(s_etat_processus, REL))
820: == NULL)
821: {
822: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
823: return;
824: }
825:
826: if ((*s_objet_argument).type == INT)
827: {
828: f77atanhi_((integer8 *) (*s_objet_argument).objet,
829: (real8 *) (*s_objet_resultat).objet);
830: }
831: else
832: {
833: f77atanhr_((real8 *) (*s_objet_argument).objet,
834: (real8 *) (*s_objet_resultat).objet);
835: }
836: }
837: else if ((argument != 1) && (argument != -1))
838: {
839: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
840: == NULL)
841: {
842: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
843: return;
844: }
845:
846: if ((*s_objet_argument).type == INT)
847: {
848: registre.partie_reelle = (real8) (*((integer8 *)
849: (*s_objet_argument).objet));
850: }
851: else
852: {
853: registre.partie_reelle = (*((real8 *)
854: (*s_objet_argument).objet));
855: }
856:
857: registre.partie_imaginaire = 0;
858:
859: f77atanhc_(®istre, (struct_complexe16 *)
860: (*s_objet_resultat).objet);
861: }
862: else
863: {
864: if (test_cfsf(s_etat_processus, 59) == d_vrai)
865: {
866: liberation(s_etat_processus, s_objet_argument);
867:
868: (*s_etat_processus).exception = d_ep_overflow;
869: return;
870: }
871: else
872: {
873: if ((s_objet_resultat = allocation(s_etat_processus, REL))
874: == NULL)
875: {
876: (*s_etat_processus).erreur_systeme =
877: d_es_allocation_memoire;
878: return;
879: }
880:
881: (*((real8 *) (*s_objet_resultat).objet)) =
882: ((double) 1) / ((double) 0);
883:
884: if (argument == -1)
885: {
886: (*((real8 *) (*s_objet_resultat).objet)) =
887: -(*((real8 *) (*s_objet_resultat).objet));
888: }
889: }
890: }
891: }
892:
893: /*
894: --------------------------------------------------------------------------------
895: Argth d'un complexe
896: --------------------------------------------------------------------------------
897: */
898:
899: else if ((*s_objet_argument).type == CPL)
900: {
901: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
902: {
903: (*s_etat_processus).erreur_systeme =
904: d_es_allocation_memoire;
905: return;
906: }
907:
908: f77atanhc_((struct_complexe16 *) (*s_objet_argument).objet,
909: (struct_complexe16 *) (*s_objet_resultat).objet);
910: }
911:
912: /*
913: --------------------------------------------------------------------------------
914: Argth d'un nom
915: --------------------------------------------------------------------------------
916: */
917:
918: else if ((*s_objet_argument).type == NOM)
919: {
920: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
921: {
922: (*s_etat_processus).erreur_systeme =
923: d_es_allocation_memoire;
924: return;
925: }
926:
927: if (((*s_objet_resultat).objet =
928: allocation_maillon(s_etat_processus)) == NULL)
929: {
930: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
931: return;
932: }
933:
934: l_element_courant = (*s_objet_resultat).objet;
935:
936: if (((*l_element_courant).donnee =
937: allocation(s_etat_processus, FCT)) == NULL)
938: {
939: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
940: return;
941: }
942:
943: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
944: .nombre_arguments = 0;
945: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
946: .fonction = instruction_vers_niveau_superieur;
947:
948: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
949: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
950: {
951: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
952: return;
953: }
954:
955: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
956: .nom_fonction, "<<");
957:
958: if (((*l_element_courant).suivant =
959: allocation_maillon(s_etat_processus)) == NULL)
960: {
961: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
962: return;
963: }
964:
965: l_element_courant = (*l_element_courant).suivant;
966: (*l_element_courant).donnee = s_objet_argument;
967:
968: if (((*l_element_courant).suivant =
969: allocation_maillon(s_etat_processus)) == NULL)
970: {
971: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
972: return;
973: }
974:
975: l_element_courant = (*l_element_courant).suivant;
976:
977: if (((*l_element_courant).donnee =
978: allocation(s_etat_processus, FCT)) == NULL)
979: {
980: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
981: return;
982: }
983:
984: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
985: .nombre_arguments = 1;
986: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
987: .fonction = instruction_atanh;
988:
989: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
990: .nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL)
991: {
992: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
993: return;
994: }
995:
996: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
997: .nom_fonction, "ATANH");
998:
999: if (((*l_element_courant).suivant =
1000: allocation_maillon(s_etat_processus)) == NULL)
1001: {
1002: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1003: return;
1004: }
1005:
1006: l_element_courant = (*l_element_courant).suivant;
1007:
1008: if (((*l_element_courant).donnee =
1009: allocation(s_etat_processus, FCT)) == NULL)
1010: {
1011: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1012: return;
1013: }
1014:
1015: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1016: .nombre_arguments = 0;
1017: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1018: .fonction = instruction_vers_niveau_inferieur;
1019:
1020: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1021: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1022: {
1023: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1024: return;
1025: }
1026:
1027: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1028: .nom_fonction, ">>");
1029:
1030: (*l_element_courant).suivant = NULL;
1031: s_objet_argument = NULL;
1032: }
1033:
1034: /*
1035: --------------------------------------------------------------------------------
1036: Argth d'une expression
1037: --------------------------------------------------------------------------------
1038: */
1039:
1040: else if (((*s_objet_argument).type == ALG) ||
1041: ((*s_objet_argument).type == RPN))
1042: {
1043: if ((s_copie_argument = copie_objet(s_etat_processus,
1044: s_objet_argument, 'N')) == NULL)
1045: {
1046: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1047: return;
1048: }
1049:
1050: l_element_courant = (struct_liste_chainee *)
1051: (*s_copie_argument).objet;
1052: l_element_precedent = l_element_courant;
1053:
1054: while((*l_element_courant).suivant != NULL)
1055: {
1056: l_element_precedent = l_element_courant;
1057: l_element_courant = (*l_element_courant).suivant;
1058: }
1059:
1060: if (((*l_element_precedent).suivant =
1061: allocation_maillon(s_etat_processus)) == NULL)
1062: {
1063: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1064: return;
1065: }
1066:
1067: if (((*(*l_element_precedent).suivant).donnee =
1068: allocation(s_etat_processus, FCT)) == NULL)
1069: {
1070: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1071: return;
1072: }
1073:
1074: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1075: .donnee).objet)).nombre_arguments = 1;
1076: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1077: .donnee).objet)).fonction = instruction_atanh;
1078:
1079: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1080: .suivant).donnee).objet)).nom_fonction =
1081: malloc(6 * sizeof(unsigned char))) == NULL)
1082: {
1083: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1084: return;
1085: }
1086:
1087: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1088: .suivant).donnee).objet)).nom_fonction, "ATANH");
1089:
1090: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1091:
1092: s_objet_resultat = s_copie_argument;
1093: }
1094:
1095: /*
1096: --------------------------------------------------------------------------------
1097: Réalisation impossible de la fonction argth
1098: --------------------------------------------------------------------------------
1099: */
1100:
1101: else
1102: {
1103: liberation(s_etat_processus, s_objet_argument);
1104:
1105: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1106: return;
1107: }
1108:
1109: liberation(s_etat_processus, s_objet_argument);
1110:
1111: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1112: s_objet_resultat) == d_erreur)
1113: {
1114: return;
1115: }
1116:
1117: return;
1118: }
1119:
1120: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_a2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src