1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.32
4: Copyright (C) 1989-2020 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 'log' (logarithme vulgaire)
29: ================================================================================
30: Entrées : pointeur sur une struct_processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_log(struct_processus *s_etat_processus)
40: {
41: integer4 erreur;
42:
43: struct_liste_chainee *l_element_courant;
44: struct_liste_chainee *l_element_precedent;
45:
46: struct_objet *s_copie_argument;
47: struct_objet *s_objet_argument;
48: struct_objet *s_objet_resultat;
49:
50: (*s_etat_processus).erreur_execution = d_ex;
51:
52: if ((*s_etat_processus).affichage_arguments == 'Y')
53: {
54: printf("\n LOG ");
55:
56: if ((*s_etat_processus).langue == 'F')
57: {
58: printf("(logarithme à base 10)\n\n");
59: }
60: else
61: {
62: printf("(10-based logarithm)\n\n");
63: }
64:
65: printf(" 1: %s, %s\n", d_INT, d_REL);
66: printf("-> 1: %s\n\n", d_REL);
67:
68: printf(" 1: %s\n", d_CPL);
69: printf("-> 1: %s\n\n", d_CPL);
70:
71: printf(" 1: %s, %s\n", d_NOM, d_ALG);
72: printf("-> 1: %s\n\n", d_ALG);
73:
74: printf(" 1: %s\n", d_RPN);
75: printf("-> 1: %s\n", d_RPN);
76:
77: return;
78: }
79: else if ((*s_etat_processus).test_instruction == 'Y')
80: {
81: (*s_etat_processus).nombre_arguments = 1;
82: return;
83: }
84:
85: if (test_cfsf(s_etat_processus, 31) == d_vrai)
86: {
87: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
88: {
89: return;
90: }
91: }
92:
93: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
94: &s_objet_argument) == d_erreur)
95: {
96: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
97: return;
98: }
99:
100: /*
101: --------------------------------------------------------------------------------
102: Logarithme décimal d'un entier
103: --------------------------------------------------------------------------------
104: */
105:
106: if ((*s_objet_argument).type == INT)
107: {
108: if ((*((integer8 *) (*s_objet_argument).objet)) >= 0)
109: {
110: if ((s_objet_resultat = allocation(s_etat_processus, REL))
111: == NULL)
112: {
113: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
114: return;
115: }
116:
117: f77logip_((integer8 *) (*s_objet_argument).objet,
118: (real8 *) (*s_objet_resultat).objet, &erreur);
119:
120: if (erreur != 0)
121: {
122: if (test_cfsf(s_etat_processus, 59) == d_vrai)
123: {
124: liberation(s_etat_processus, s_objet_argument);
125: liberation(s_etat_processus, s_objet_resultat);
126:
127: (*s_etat_processus).exception = d_ep_overflow;
128: return;
129: }
130: else
131: {
132: (*((real8 *) (*s_objet_resultat).objet)) =
133: ((double) 1) / ((double) 0);
134: }
135: }
136: }
137: else
138: {
139: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
140: == NULL)
141: {
142: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
143: return;
144: }
145:
146: f77login_((integer8 *) (*s_objet_argument).objet,
147: (struct_complexe16 *) (*s_objet_resultat).objet,
148: &erreur);
149:
150: if (erreur != 0)
151: {
152: if (test_cfsf(s_etat_processus, 59) == d_vrai)
153: {
154: liberation(s_etat_processus, s_objet_argument);
155: liberation(s_etat_processus, s_objet_resultat);
156:
157: (*s_etat_processus).exception = d_ep_overflow;
158: return;
159: }
160: else
161: {
162: free((*s_objet_resultat).objet);
163:
164: if (((*s_objet_resultat).objet = malloc(sizeof(
165: real8))) == NULL)
166: {
167: (*s_etat_processus).erreur_systeme =
168: d_es_allocation_memoire;
169: return;
170: }
171:
172: (*s_objet_resultat).type = REL;
173: (*((real8 *) (*s_objet_resultat).objet)) =
174: ((double) 1) / ((double) 0);
175: }
176: }
177: }
178: }
179:
180: /*
181: --------------------------------------------------------------------------------
182: Logarithme décimal d'un réel
183: --------------------------------------------------------------------------------
184: */
185:
186: else if ((*s_objet_argument).type == REL)
187: {
188: if ((*((real8 *) (*s_objet_argument).objet)) >= 0)
189: {
190: if ((s_objet_resultat = allocation(s_etat_processus, REL))
191: == NULL)
192: {
193: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
194: return;
195: }
196:
197: f77logrp_((real8 *) (*s_objet_argument).objet,
198: (real8 *) (*s_objet_resultat).objet, &erreur);
199:
200: if (erreur != 0)
201: {
202: if (test_cfsf(s_etat_processus, 59) == d_vrai)
203: {
204: liberation(s_etat_processus, s_objet_argument);
205: liberation(s_etat_processus, s_objet_resultat);
206:
207: (*s_etat_processus).exception = d_ep_overflow;
208: return;
209: }
210: else
211: {
212: (*((real8 *) (*s_objet_resultat).objet)) =
213: ((double) 1) / ((double) 0);
214: }
215: }
216: }
217: else
218: {
219: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
220: == NULL)
221: {
222: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
223: return;
224: }
225:
226: f77logrn_((real8 *) (*s_objet_argument).objet,
227: (struct_complexe16 *) (*s_objet_resultat).objet,
228: &erreur);
229:
230: if (erreur != 0)
231: {
232: if (test_cfsf(s_etat_processus, 59) == d_vrai)
233: {
234: liberation(s_etat_processus, s_objet_argument);
235: liberation(s_etat_processus, s_objet_resultat);
236:
237: (*s_etat_processus).exception = d_ep_overflow;
238: return;
239: }
240: else
241: {
242: free((*s_objet_resultat).objet);
243:
244: if (((*s_objet_resultat).objet = malloc(sizeof(
245: real8))) == NULL)
246: {
247: (*s_etat_processus).erreur_systeme =
248: d_es_allocation_memoire;
249: return;
250: }
251:
252: (*s_objet_resultat).type = REL;
253: (*((real8 *) (*s_objet_resultat).objet)) =
254: ((double) 1) / ((double) 0);
255: }
256: }
257: }
258: }
259:
260: /*
261: --------------------------------------------------------------------------------
262: Logarithme décimal d'un complexe
263: --------------------------------------------------------------------------------
264: */
265:
266: else if ((*s_objet_argument).type == CPL)
267: {
268: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
269: == NULL)
270: {
271: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
272: return;
273: }
274:
275: f77logc_((struct_complexe16 *) (*s_objet_argument).objet,
276: (struct_complexe16 *) (*s_objet_resultat).objet,
277: &erreur);
278:
279: if (erreur != 0)
280: {
281: if (test_cfsf(s_etat_processus, 59) == d_vrai)
282: {
283: liberation(s_etat_processus, s_objet_argument);
284: liberation(s_etat_processus, s_objet_resultat);
285:
286: (*s_etat_processus).exception = d_ep_overflow;
287: return;
288: }
289: else
290: {
291: free((*s_objet_resultat).objet);
292:
293: if (((*s_objet_resultat).objet = malloc(sizeof(
294: real8))) == NULL)
295: {
296: (*s_etat_processus).erreur_systeme =
297: d_es_allocation_memoire;
298: return;
299: }
300:
301: (*s_objet_resultat).type = REL;
302: (*((real8 *) (*s_objet_resultat).objet)) =
303: ((double) 1) / ((double) 0);
304: }
305: }
306: }
307:
308: /*
309: --------------------------------------------------------------------------------
310: Logarithme décimal d'un nom
311: --------------------------------------------------------------------------------
312: */
313:
314: else if ((*s_objet_argument).type == NOM)
315: {
316: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
317: == NULL)
318: {
319: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
320: return;
321: }
322:
323: if (((*s_objet_resultat).objet =
324: allocation_maillon(s_etat_processus)) == NULL)
325: {
326: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
327: return;
328: }
329:
330: l_element_courant = (*s_objet_resultat).objet;
331:
332: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
333: == NULL)
334: {
335: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
336: return;
337: }
338:
339: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
340: .nombre_arguments = 0;
341: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
342: .fonction = instruction_vers_niveau_superieur;
343:
344: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
345: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
346: {
347: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
348: return;
349: }
350:
351: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
352: .nom_fonction, "<<");
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;
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 = allocation(s_etat_processus, FCT))
374: == 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 = 1;
382: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
383: .fonction = instruction_log;
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, "LOG");
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 = allocation(s_etat_processus, FCT))
405: == 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: s_objet_argument = NULL;
428: }
429:
430: /*
431: --------------------------------------------------------------------------------
432: Logarithme décimal d'une expression
433: --------------------------------------------------------------------------------
434: */
435:
436: else if (((*s_objet_argument).type == ALG) ||
437: ((*s_objet_argument).type == RPN))
438: {
439: if ((s_copie_argument = copie_objet(s_etat_processus,
440: s_objet_argument, 'N')) == NULL)
441: {
442: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
443: return;
444: }
445:
446: l_element_courant = (struct_liste_chainee *)
447: (*s_copie_argument).objet;
448: l_element_precedent = l_element_courant;
449:
450: while((*l_element_courant).suivant != NULL)
451: {
452: l_element_precedent = l_element_courant;
453: l_element_courant = (*l_element_courant).suivant;
454: }
455:
456: if (((*l_element_precedent).suivant =
457: allocation_maillon(s_etat_processus)) == NULL)
458: {
459: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
460: return;
461: }
462:
463: if (((*(*l_element_precedent).suivant).donnee =
464: allocation(s_etat_processus, FCT)) == NULL)
465: {
466: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
467: return;
468: }
469:
470: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
471: .donnee).objet)).nombre_arguments = 1;
472: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
473: .donnee).objet)).fonction = instruction_log;
474:
475: if (((*((struct_fonction *) (*(*(*l_element_precedent)
476: .suivant).donnee).objet)).nom_fonction =
477: malloc(4 * sizeof(unsigned char))) == NULL)
478: {
479: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
480: return;
481: }
482:
483: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
484: .suivant).donnee).objet)).nom_fonction, "LOG");
485:
486: (*(*l_element_precedent).suivant).suivant = l_element_courant;
487:
488: s_objet_resultat = s_copie_argument;
489: }
490:
491: /*
492: --------------------------------------------------------------------------------
493: Fonction logarithme décimal impossible à réaliser
494: --------------------------------------------------------------------------------
495: */
496:
497: else
498: {
499: liberation(s_etat_processus, s_objet_argument);
500:
501: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
502: return;
503: }
504:
505: liberation(s_etat_processus, s_objet_argument);
506:
507: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
508: s_objet_resultat) == d_erreur)
509: {
510: return;
511: }
512:
513: return;
514: }
515:
516:
517: /*
518: ================================================================================
519: Fonction 'ln' (logarithme népérien)
520: ================================================================================
521: Entrées : pointeur sur une struct_processus
522: --------------------------------------------------------------------------------
523: Sorties :
524: --------------------------------------------------------------------------------
525: Effets de bord : néant
526: ================================================================================
527: */
528:
529: void
530: instruction_ln(struct_processus *s_etat_processus)
531: {
532: integer4 erreur;
533:
534: struct_liste_chainee *l_element_courant;
535: struct_liste_chainee *l_element_precedent;
536:
537: struct_objet *s_copie_argument;
538: struct_objet *s_objet_argument;
539: struct_objet *s_objet_resultat;
540:
541: (*s_etat_processus).erreur_execution = d_ex;
542:
543: if ((*s_etat_processus).affichage_arguments == 'Y')
544: {
545: printf("\n LN ");
546:
547: if ((*s_etat_processus).langue == 'F')
548: {
549: printf("(logarithme népérien)\n\n");
550: }
551: else
552: {
553: printf("(natural logarithm)\n\n");
554: }
555:
556: printf(" 1: %s, %s\n", d_INT, d_REL);
557: printf("-> 1: %s\n\n", d_REL);
558:
559: printf(" 1: %s\n", d_CPL);
560: printf("-> 1: %s\n\n", d_CPL);
561:
562: printf(" 1: %s, %s\n", d_NOM, d_ALG);
563: printf("-> 1: %s\n\n", d_ALG);
564:
565: printf(" 1: %s\n", d_RPN);
566: printf("-> 1: %s\n", d_RPN);
567:
568: return;
569: }
570: else if ((*s_etat_processus).test_instruction == 'Y')
571: {
572: (*s_etat_processus).nombre_arguments = 1;
573: return;
574: }
575:
576: if (test_cfsf(s_etat_processus, 31) == d_vrai)
577: {
578: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
579: {
580: return;
581: }
582: }
583:
584: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
585: &s_objet_argument) == d_erreur)
586: {
587: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
588: return;
589: }
590:
591: /*
592: --------------------------------------------------------------------------------
593: Logarithme naturel d'un entier
594: --------------------------------------------------------------------------------
595: */
596:
597: if ((*s_objet_argument).type == INT)
598: {
599: if ((*((integer8 *) (*s_objet_argument).objet)) >= 0)
600: {
601: if ((s_objet_resultat = allocation(s_etat_processus, REL))
602: == NULL)
603: {
604: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
605: return;
606: }
607:
608: f77lnip_((integer8 *) (*s_objet_argument).objet,
609: (real8 *) (*s_objet_resultat).objet, &erreur);
610:
611: if (erreur != 0)
612: {
613: if (test_cfsf(s_etat_processus, 59) == d_vrai)
614: {
615: liberation(s_etat_processus, s_objet_argument);
616: liberation(s_etat_processus, s_objet_resultat);
617:
618: (*s_etat_processus).exception = d_ep_overflow;
619: return;
620: }
621: else
622: {
623: (*((real8 *) (*s_objet_resultat).objet)) =
624: ((double) 1) / ((double) 0);
625: }
626: }
627: }
628: else
629: {
630: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
631: == NULL)
632: {
633: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
634: return;
635: }
636:
637: f77lnin_((integer8 *) (*s_objet_argument).objet,
638: (struct_complexe16 *) (*s_objet_resultat).objet,
639: &erreur);
640:
641: if (erreur != 0)
642: {
643: if (test_cfsf(s_etat_processus, 59) == d_vrai)
644: {
645: liberation(s_etat_processus, s_objet_argument);
646: liberation(s_etat_processus, s_objet_resultat);
647:
648: (*s_etat_processus).exception = d_ep_overflow;
649: return;
650: }
651: else
652: {
653: free((*s_objet_resultat).objet);
654:
655: if (((*s_objet_resultat).objet = malloc(sizeof(
656: real8))) == NULL)
657: {
658: (*s_etat_processus).erreur_systeme =
659: d_es_allocation_memoire;
660: return;
661: }
662:
663: (*s_objet_resultat).type = REL;
664: (*((real8 *) (*s_objet_resultat).objet)) =
665: ((double) 1) / ((double) 0);
666: }
667: }
668: }
669: }
670:
671: /*
672: --------------------------------------------------------------------------------
673: Logarithme naturel d'un réel
674: --------------------------------------------------------------------------------
675: */
676:
677: else if ((*s_objet_argument).type == REL)
678: {
679: if ((*((real8 *) (*s_objet_argument).objet)) >= 0)
680: {
681: if ((s_objet_resultat = allocation(s_etat_processus, REL))
682: == NULL)
683: {
684: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
685: return;
686: }
687:
688: f77lnrp_((real8 *) (*s_objet_argument).objet,
689: (real8 *) (*s_objet_resultat).objet, &erreur);
690:
691: if (erreur != 0)
692: {
693: if (test_cfsf(s_etat_processus, 59) == d_vrai)
694: {
695: liberation(s_etat_processus, s_objet_argument);
696: liberation(s_etat_processus, s_objet_resultat);
697:
698: (*s_etat_processus).exception = d_ep_overflow;
699: return;
700: }
701: else
702: {
703: (*((real8 *) (*s_objet_resultat).objet)) =
704: ((double) 1) / ((double) 0);
705: }
706: }
707: }
708: else
709: {
710: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
711: == NULL)
712: {
713: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
714: return;
715: }
716:
717: f77lnrn_((real8 *) (*s_objet_argument).objet,
718: (struct_complexe16 *) (*s_objet_resultat).objet,
719: &erreur);
720:
721: if (erreur != 0)
722: {
723: if (test_cfsf(s_etat_processus, 59) == d_vrai)
724: {
725: liberation(s_etat_processus, s_objet_argument);
726: liberation(s_etat_processus, s_objet_resultat);
727:
728: (*s_etat_processus).exception = d_ep_overflow;
729: return;
730: }
731: else
732: {
733: free((*s_objet_resultat).objet);
734:
735: if (((*s_objet_resultat).objet = malloc(sizeof(
736: real8))) == NULL)
737: {
738: (*s_etat_processus).erreur_systeme =
739: d_es_allocation_memoire;
740: return;
741: }
742:
743: (*s_objet_resultat).type = REL;
744: (*((real8 *) (*s_objet_resultat).objet)) =
745: ((double) 1) / ((double) 0);
746: }
747: }
748: }
749: }
750:
751: /*
752: --------------------------------------------------------------------------------
753: Logarithme naturel d'un complexe
754: --------------------------------------------------------------------------------
755: */
756:
757: else if ((*s_objet_argument).type == CPL)
758: {
759: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
760: == NULL)
761: {
762: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
763: return;
764: }
765:
766: f77lnc_((struct_complexe16 *) (*s_objet_argument).objet,
767: (struct_complexe16 *) (*s_objet_resultat).objet,
768: &erreur);
769:
770: if (erreur != 0)
771: {
772: if (test_cfsf(s_etat_processus, 59) == d_vrai)
773: {
774: liberation(s_etat_processus, s_objet_argument);
775: liberation(s_etat_processus, s_objet_resultat);
776:
777: (*s_etat_processus).exception = d_ep_overflow;
778: return;
779: }
780: else
781: {
782: free((*s_objet_resultat).objet);
783:
784: if (((*s_objet_resultat).objet = malloc(sizeof(
785: real8))) == NULL)
786: {
787: (*s_etat_processus).erreur_systeme =
788: d_es_allocation_memoire;
789: return;
790: }
791:
792: (*s_objet_resultat).type = REL;
793: (*((real8 *) (*s_objet_resultat).objet)) =
794: ((double) 1) / ((double) 0);
795: }
796: }
797: }
798:
799: /*
800: --------------------------------------------------------------------------------
801: Logarithme naturel d'un nom
802: --------------------------------------------------------------------------------
803: */
804:
805: else if ((*s_objet_argument).type == NOM)
806: {
807: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
808: == NULL)
809: {
810: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
811: return;
812: }
813:
814: if (((*s_objet_resultat).objet =
815: allocation_maillon(s_etat_processus)) == NULL)
816: {
817: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
818: return;
819: }
820:
821: l_element_courant = (*s_objet_resultat).objet;
822:
823: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
824: == NULL)
825: {
826: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
827: return;
828: }
829:
830: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
831: .nombre_arguments = 0;
832: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
833: .fonction = instruction_vers_niveau_superieur;
834:
835: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
836: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
837: {
838: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
839: return;
840: }
841:
842: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
843: .nom_fonction, "<<");
844:
845: if (((*l_element_courant).suivant =
846: allocation_maillon(s_etat_processus)) == NULL)
847: {
848: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
849: return;
850: }
851:
852: l_element_courant = (*l_element_courant).suivant;
853: (*l_element_courant).donnee = s_objet_argument;
854:
855: if (((*l_element_courant).suivant =
856: allocation_maillon(s_etat_processus)) == NULL)
857: {
858: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
859: return;
860: }
861:
862: l_element_courant = (*l_element_courant).suivant;
863:
864: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
865: == NULL)
866: {
867: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
868: return;
869: }
870:
871: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
872: .nombre_arguments = 1;
873: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
874: .fonction = instruction_ln;
875:
876: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
877: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
878: {
879: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
880: return;
881: }
882:
883: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
884: .nom_fonction, "LN");
885:
886: if (((*l_element_courant).suivant =
887: allocation_maillon(s_etat_processus)) == NULL)
888: {
889: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
890: return;
891: }
892:
893: l_element_courant = (*l_element_courant).suivant;
894:
895: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
896: == NULL)
897: {
898: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
899: return;
900: }
901:
902: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
903: .nombre_arguments = 0;
904: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
905: .fonction = instruction_vers_niveau_inferieur;
906:
907: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
908: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
909: {
910: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
911: return;
912: }
913:
914: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
915: .nom_fonction, ">>");
916:
917: (*l_element_courant).suivant = NULL;
918: s_objet_argument = NULL;
919: }
920:
921: /*
922: --------------------------------------------------------------------------------
923: Logarithme naturel d'une expression
924: --------------------------------------------------------------------------------
925: */
926:
927: else if (((*s_objet_argument).type == ALG) ||
928: ((*s_objet_argument).type == RPN))
929: {
930: if ((s_copie_argument = copie_objet(s_etat_processus,
931: s_objet_argument, 'N')) == NULL)
932: {
933: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
934: return;
935: }
936:
937: l_element_courant = (struct_liste_chainee *)
938: (*s_copie_argument).objet;
939: l_element_precedent = l_element_courant;
940:
941: while((*l_element_courant).suivant != NULL)
942: {
943: l_element_precedent = l_element_courant;
944: l_element_courant = (*l_element_courant).suivant;
945: }
946:
947: if (((*l_element_precedent).suivant =
948: allocation_maillon(s_etat_processus)) == NULL)
949: {
950: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
951: return;
952: }
953:
954: if (((*(*l_element_precedent).suivant).donnee =
955: allocation(s_etat_processus, FCT)) == NULL)
956: {
957: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
958: return;
959: }
960:
961: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
962: .donnee).objet)).nombre_arguments = 1;
963: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
964: .donnee).objet)).fonction = instruction_ln;
965:
966: if (((*((struct_fonction *) (*(*(*l_element_precedent)
967: .suivant).donnee).objet)).nom_fonction =
968: malloc(3 * sizeof(unsigned char))) == NULL)
969: {
970: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
971: return;
972: }
973:
974: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
975: .suivant).donnee).objet)).nom_fonction, "LN");
976:
977: (*(*l_element_precedent).suivant).suivant = l_element_courant;
978:
979: s_objet_resultat = s_copie_argument;
980: }
981:
982: /*
983: --------------------------------------------------------------------------------
984: Fonction logarithme naturel impossible à réaliser
985: --------------------------------------------------------------------------------
986: */
987:
988: else
989: {
990: liberation(s_etat_processus, s_objet_argument);
991:
992: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
993: return;
994: }
995:
996: liberation(s_etat_processus, s_objet_argument);
997:
998: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
999: s_objet_resultat) == d_erreur)
1000: {
1001: return;
1002: }
1003:
1004: return;
1005: }
1006:
1007:
1008: /*
1009: ================================================================================
1010: Fonction 'lnp1' (logarithme népérien)
1011: ================================================================================
1012: Entrées : pointeur sur une struct_processus
1013: --------------------------------------------------------------------------------
1014: Sorties :
1015: --------------------------------------------------------------------------------
1016: Effets de bord : néant
1017: ================================================================================
1018: */
1019:
1020: void
1021: instruction_lnp1(struct_processus *s_etat_processus)
1022: {
1023: int erreur;
1024:
1025: struct_liste_chainee *l_element_courant;
1026: struct_liste_chainee *l_element_precedent;
1027:
1028: struct_objet *s_copie_argument;
1029: struct_objet *s_objet_argument;
1030: struct_objet *s_objet_resultat;
1031:
1032: (*s_etat_processus).erreur_execution = d_ex;
1033:
1034: if ((*s_etat_processus).affichage_arguments == 'Y')
1035: {
1036: printf("\n LNP1 ");
1037:
1038: if ((*s_etat_processus).langue == 'F')
1039: {
1040: printf("(logarithme népérien plus un)\n\n");
1041: }
1042: else
1043: {
1044: printf("(ln + 1)\n\n");
1045: }
1046:
1047: printf(" 1: %s, %s\n", d_INT, d_REL);
1048: printf("-> 1: %s\n\n", d_REL);
1049:
1050: printf(" 1: %s\n", d_CPL);
1051: printf("-> 1: %s\n\n", d_CPL);
1052:
1053: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1054: printf("-> 1: %s\n\n", d_ALG);
1055:
1056: printf(" 1: %s\n", d_RPN);
1057: printf("-> 1: %s\n", d_RPN);
1058:
1059: return;
1060: }
1061: else if ((*s_etat_processus).test_instruction == 'Y')
1062: {
1063: (*s_etat_processus).nombre_arguments = 1;
1064: return;
1065: }
1066:
1067: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1068: {
1069: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1070: {
1071: return;
1072: }
1073: }
1074:
1075: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1076: &s_objet_argument) == d_erreur)
1077: {
1078: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1079: return;
1080: }
1081:
1082: /*
1083: --------------------------------------------------------------------------------
1084: Logarithme naturel (+1) d'un entier
1085: --------------------------------------------------------------------------------
1086: */
1087:
1088: if ((*s_objet_argument).type == INT)
1089: {
1090: if ((*((integer8 *) (*s_objet_argument).objet)) > -1)
1091: {
1092: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1093: == NULL)
1094: {
1095: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1096: return;
1097: }
1098:
1099: erreur = (finite((*((real8 *) (*s_objet_resultat).objet)) =
1100: log1p((real8) (*((integer8 *)
1101: (*s_objet_argument).objet)))) == 0);
1102:
1103: if (erreur != 0)
1104: {
1105: if (test_cfsf(s_etat_processus, 59) == d_vrai)
1106: {
1107: liberation(s_etat_processus, s_objet_argument);
1108: liberation(s_etat_processus, s_objet_resultat);
1109:
1110: (*s_etat_processus).exception = d_ep_overflow;
1111: return;
1112: }
1113: else
1114: {
1115: (*((real8 *) (*s_objet_resultat).objet)) =
1116: ((double) 1) / ((double) 0);
1117: }
1118: }
1119: }
1120: else
1121: {
1122: if (test_cfsf(s_etat_processus, 59) == d_vrai)
1123: {
1124: liberation(s_etat_processus, s_objet_argument);
1125:
1126: (*s_etat_processus).exception = d_ep_overflow;
1127: return;
1128: }
1129: else
1130: {
1131: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1132: == NULL)
1133: {
1134: (*s_etat_processus).erreur_systeme =
1135: d_es_allocation_memoire;
1136: return;
1137: }
1138:
1139: (*((real8 *) (*s_objet_resultat).objet)) =
1140: ((double) 0) / ((double) 0);
1141: }
1142: }
1143: }
1144:
1145: /*
1146: --------------------------------------------------------------------------------
1147: Logarithme naturel (+1) d'un réel
1148: --------------------------------------------------------------------------------
1149: */
1150:
1151: else if ((*s_objet_argument).type == REL)
1152: {
1153: if ((*((real8 *) (*s_objet_argument).objet)) > -1)
1154: {
1155: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1156: == NULL)
1157: {
1158: (*s_etat_processus).erreur_systeme =
1159: d_es_allocation_memoire;
1160: return;
1161: }
1162:
1163: erreur = (finite((*((real8 *) (*s_objet_resultat).objet)) =
1164: log1p((*((real8 *) (*s_objet_argument).objet)))) == 0);
1165:
1166: if (erreur != 0)
1167: {
1168: if (test_cfsf(s_etat_processus, 59) == d_vrai)
1169: {
1170: liberation(s_etat_processus, s_objet_argument);
1171: liberation(s_etat_processus, s_objet_resultat);
1172:
1173: (*s_etat_processus).exception = d_ep_overflow;
1174: return;
1175: }
1176: else
1177: {
1178: (*((real8 *) (*s_objet_resultat).objet)) =
1179: ((double) 1) / ((double) 0);
1180: }
1181: }
1182: }
1183: else
1184: {
1185: if (test_cfsf(s_etat_processus, 59) == d_vrai)
1186: {
1187: liberation(s_etat_processus, s_objet_argument);
1188:
1189: (*s_etat_processus).exception = d_ep_overflow;
1190: return;
1191: }
1192: else
1193: {
1194: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1195: == NULL)
1196: {
1197: (*s_etat_processus).erreur_systeme =
1198: d_es_allocation_memoire;
1199: return;
1200: }
1201:
1202: (*((real8 *) (*s_objet_resultat).objet)) =
1203: ((double) 0) / ((double) 0);
1204: }
1205: }
1206: }
1207:
1208: /*
1209: --------------------------------------------------------------------------------
1210: Logarithme naturel (+1) d'un nom
1211: --------------------------------------------------------------------------------
1212: */
1213:
1214: else if ((*s_objet_argument).type == NOM)
1215: {
1216: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
1217: == NULL)
1218: {
1219: (*s_etat_processus).erreur_systeme =
1220: d_es_allocation_memoire;
1221: return;
1222: }
1223:
1224: if (((*s_objet_resultat).objet =
1225: allocation_maillon(s_etat_processus)) == NULL)
1226: {
1227: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1228: return;
1229: }
1230:
1231: l_element_courant = (*s_objet_resultat).objet;
1232:
1233: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1234: == NULL)
1235: {
1236: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1237: return;
1238: }
1239:
1240: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1241: .nombre_arguments = 0;
1242: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1243: .fonction = instruction_vers_niveau_superieur;
1244:
1245: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1246: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1247: {
1248: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1249: return;
1250: }
1251:
1252: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1253: .nom_fonction, "<<");
1254:
1255: if (((*l_element_courant).suivant =
1256: allocation_maillon(s_etat_processus)) == NULL)
1257: {
1258: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1259: return;
1260: }
1261:
1262: l_element_courant = (*l_element_courant).suivant;
1263: (*l_element_courant).donnee = s_objet_argument;
1264:
1265: if (((*l_element_courant).suivant =
1266: allocation_maillon(s_etat_processus)) == NULL)
1267: {
1268: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1269: return;
1270: }
1271:
1272: l_element_courant = (*l_element_courant).suivant;
1273:
1274: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1275: == NULL)
1276: {
1277: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1278: return;
1279: }
1280:
1281: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1282: .nombre_arguments = 1;
1283: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1284: .fonction = instruction_lnp1;
1285:
1286: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1287: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
1288: {
1289: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1290: return;
1291: }
1292:
1293: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1294: .nom_fonction, "LNP1");
1295:
1296: if (((*l_element_courant).suivant =
1297: allocation_maillon(s_etat_processus)) == NULL)
1298: {
1299: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1300: return;
1301: }
1302:
1303: l_element_courant = (*l_element_courant).suivant;
1304:
1305: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1306: == NULL)
1307: {
1308: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1309: return;
1310: }
1311:
1312: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1313: .nombre_arguments = 0;
1314: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1315: .fonction = instruction_vers_niveau_inferieur;
1316:
1317: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1318: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1319: {
1320: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1321: return;
1322: }
1323:
1324: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1325: .nom_fonction, ">>");
1326:
1327: (*l_element_courant).suivant = NULL;
1328: s_objet_argument = NULL;
1329: }
1330:
1331: /*
1332: --------------------------------------------------------------------------------
1333: Logarithme naturel (+1) d'une expression
1334: --------------------------------------------------------------------------------
1335: */
1336:
1337: else if (((*s_objet_argument).type == ALG) ||
1338: ((*s_objet_argument).type == RPN))
1339: {
1340: if ((s_copie_argument = copie_objet(s_etat_processus,
1341: s_objet_argument, 'N')) == NULL)
1342: {
1343: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1344: return;
1345: }
1346:
1347: l_element_courant = (struct_liste_chainee *)
1348: (*s_copie_argument).objet;
1349: l_element_precedent = l_element_courant;
1350:
1351: while((*l_element_courant).suivant != NULL)
1352: {
1353: l_element_precedent = l_element_courant;
1354: l_element_courant = (*l_element_courant).suivant;
1355: }
1356:
1357: if (((*l_element_precedent).suivant =
1358: allocation_maillon(s_etat_processus)) == NULL)
1359: {
1360: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1361: return;
1362: }
1363:
1364: if (((*(*l_element_precedent).suivant).donnee =
1365: allocation(s_etat_processus, FCT)) == NULL)
1366: {
1367: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1368: return;
1369: }
1370:
1371: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1372: .donnee).objet)).nombre_arguments = 1;
1373: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1374: .donnee).objet)).fonction = instruction_lnp1;
1375:
1376: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1377: .suivant).donnee).objet)).nom_fonction =
1378: malloc(5 * sizeof(unsigned char))) == NULL)
1379: {
1380: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1381: return;
1382: }
1383:
1384: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1385: .suivant).donnee).objet)).nom_fonction, "LNP1");
1386:
1387: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1388:
1389: s_objet_resultat = s_copie_argument;
1390: }
1391:
1392: /*
1393: --------------------------------------------------------------------------------
1394: Fonction logarithme naturel (+1) impossible à réaliser
1395: --------------------------------------------------------------------------------
1396: */
1397:
1398: else
1399: {
1400: liberation(s_etat_processus, s_objet_argument);
1401:
1402: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1403: return;
1404: }
1405:
1406: liberation(s_etat_processus, s_objet_argument);
1407:
1408: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1409: s_objet_resultat) == d_erreur)
1410: {
1411: return;
1412: }
1413:
1414: return;
1415: }
1416:
1417: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_l2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src