1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.13
4: Copyright (C) 1989-2013 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 'type'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_type(struct_processus *s_etat_processus)
40: {
41: struct_objet *s_objet_argument;
42: struct_objet *s_objet_resultat;
43:
44: (*s_etat_processus).erreur_execution = d_ex;
45:
46: if ((*s_etat_processus).affichage_arguments == 'Y')
47: {
48: printf("\n TYPE ");
49:
50: if ((*s_etat_processus).langue == 'F')
51: {
52: printf("(type d'objet)\n\n");
53: }
54: else
55: {
56: printf("(object type)\n\n");
57: }
58:
59: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
60: " %s, %s, %s, %s, %s,\n"
61: " %s, %s, %s, %s, %s,\n"
62: " %s, %s, %s, %s\n",
63: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
64: d_TAB,
65: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB, d_SCK,
66: d_PRC);
67: printf("-> 1: %s\n\n", d_INT);
68:
69: if ((*s_etat_processus).langue == 'F')
70: {
71: printf(" Valeurs renvoyées : \n\n");
72: printf(" 0 : scalaire (entier ou réel)\n");
73: printf(" 1 : complexe\n");
74: printf(" 2 : chaîne de caractères\n");
75: printf(" 3 : vecteur ou matrice de scalaires\n");
76: printf(" 4 : vecteur ou matrice de complexes\n");
77: printf(" 5 : liste\n");
78: printf(" 6 : adresse\n");
79: printf(" 7 : nom\n");
80: printf(" 8 : expression en notation polonaire inversée\n");
81: printf(" 9 : expression algébrique\n");
82: printf(" 10 : entier binaire\n");
83: printf(" 11 : descripteur de fichier\n");
84: printf(" 12 : descripteur de bibliothèque partagée\n");
85: printf(" 13 : descripteur de socket\n");
86: printf(" 14 : processus\n");
87: printf(" 15 : fonction\n");
88: printf(" 16 : table\n");
89: }
90: else
91: {
92: printf(" Returned values : \n\n");
93: printf(" 0 : scalar, integer or real number\n");
94: printf(" 1 : complex\n");
95: printf(" 2 : string\n");
96: printf(" 3 : scalar vector or scalar matrix\n");
97: printf(" 4 : complex vector or complex matrix\n");
98: printf(" 5 : list\n");
99: printf(" 6 : address\n");
100: printf(" 7 : name\n");
101: printf(" 8 : RPN expression\n");
102: printf(" 9 : algebraic expression\n");
103: printf(" 10 : binary integer\n");
104: printf(" 11 : file descriptor\n");
105: printf(" 12 : shared library descriptor\n");
106: printf(" 13 : socket descriptor\n");
107: printf(" 14 : process\n");
108: printf(" 15 : function\n");
109: printf(" 16 : table\n");
110: }
111:
112: return;
113: }
114: else if ((*s_etat_processus).test_instruction == 'Y')
115: {
116: (*s_etat_processus).nombre_arguments = -1;
117: return;
118: }
119:
120: if (test_cfsf(s_etat_processus, 31) == d_vrai)
121: {
122: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
123: {
124: return;
125: }
126: }
127:
128: if (depilement(s_etat_processus, &((*s_etat_processus)
129: .l_base_pile), &s_objet_argument) == d_erreur)
130: {
131: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
132: return;
133: }
134:
135: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
136: {
137: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
138: return;
139: }
140:
141: if (((*s_objet_argument).type == INT) ||
142: ((*s_objet_argument).type == REL))
143: {
144: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
145: }
146: else if ((*s_objet_argument).type == CPL)
147: {
148: (*((integer8 *) (*s_objet_resultat).objet)) = 1;
149: }
150: else if ((*s_objet_argument).type == CHN)
151: {
152: (*((integer8 *) (*s_objet_resultat).objet)) = 2;
153: }
154: else if (((*s_objet_argument).type == VIN) ||
155: ((*s_objet_argument).type == VRL) ||
156: ((*s_objet_argument).type == MIN) ||
157: ((*s_objet_argument).type == MRL))
158: {
159: (*((integer8 *) (*s_objet_resultat).objet)) = 3;
160: }
161: else if (((*s_objet_argument).type == VCX) ||
162: ((*s_objet_argument).type == MCX))
163: {
164: (*((integer8 *) (*s_objet_resultat).objet)) = 4;
165: }
166: else if ((*s_objet_argument).type == LST)
167: {
168: (*((integer8 *) (*s_objet_resultat).objet)) = 5;
169: }
170: else if ((*s_objet_argument).type == ADR)
171: {
172: (*((integer8 *) (*s_objet_resultat).objet)) = 6;
173: }
174: else if ((*s_objet_argument).type == NOM)
175: {
176: (*((integer8 *) (*s_objet_resultat).objet)) = 7;
177: }
178: else if ((*s_objet_argument).type == RPN)
179: {
180: (*((integer8 *) (*s_objet_resultat).objet)) = 8;
181: }
182: else if ((*s_objet_argument).type == ALG)
183: {
184: (*((integer8 *) (*s_objet_resultat).objet)) = 9;
185: }
186: else if ((*s_objet_argument).type == BIN)
187: {
188: (*((integer8 *) (*s_objet_resultat).objet)) = 10;
189: }
190: else if ((*s_objet_argument).type == FCH)
191: {
192: (*((integer8 *) (*s_objet_resultat).objet)) = 11;
193: }
194: else if ((*s_objet_argument).type == SLB)
195: {
196: (*((integer8 *) (*s_objet_resultat).objet)) = 12;
197: }
198: else if ((*s_objet_argument).type == SCK)
199: {
200: (*((integer8 *) (*s_objet_resultat).objet)) = 13;
201: }
202: else if ((*s_objet_argument).type == PRC)
203: {
204: (*((integer8 *) (*s_objet_resultat).objet)) = 14;
205: }
206: else if ((*s_objet_argument).type == FCT)
207: {
208: (*((integer8 *) (*s_objet_resultat).objet)) = 15;
209: }
210: else if ((*s_objet_argument).type == TBL)
211: {
212: (*((integer8 *) (*s_objet_resultat).objet)) = 16;
213: }
214: else
215: {
216: /*
217: * Les autres types de données sont des types internes
218: */
219:
220: liberation(s_etat_processus, s_objet_argument);
221:
222: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
223: return;
224: }
225:
226: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
227: s_objet_resultat) == d_erreur)
228: {
229: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
230: return;
231: }
232:
233: liberation(s_etat_processus, s_objet_argument);
234:
235: return;
236: }
237:
238:
239: /*
240: ================================================================================
241: Fonction 'then'
242: ================================================================================
243: Entrées : structure processus
244: --------------------------------------------------------------------------------
245: Sorties :
246: --------------------------------------------------------------------------------
247: Effets de bord : néant
248: ================================================================================
249: */
250:
251: void
252: instruction_then(struct_processus *s_etat_processus)
253: {
254: logical1 condition;
255: logical1 drapeau_fin;
256: logical1 execution;
257:
258: struct_liste_chainee *s_registre;
259:
260: struct_liste_pile_systeme *l_element_courant;
261:
262: struct_objet *s_objet;
263:
264: unsigned char *instruction_majuscule;
265: unsigned char *tampon;
266:
267: integer8 niveau;
268:
269: void (*fonction)();
270:
271: (*s_etat_processus).erreur_execution = d_ex;
272:
273: if ((*s_etat_processus).affichage_arguments == 'Y')
274: {
275: printf("\n THEN ");
276:
277: if ((*s_etat_processus).langue == 'F')
278: {
279: printf("(structure de contrôle)\n\n");
280: printf(" Utilisation :\n\n");
281: }
282: else
283: {
284: printf("(control statement)\n\n");
285: printf(" Usage:\n\n");
286: }
287:
288: printf(" IF(ERR)\n");
289: printf(" (expression test 1)\n");
290: printf(" THEN\n");
291: printf(" (expression 1)\n");
292: printf(" [ELSEIF\n");
293: printf(" (expression test 2)\n");
294: printf(" THEN\n");
295: printf(" (expression 2)]\n");
296: printf(" ...\n");
297: printf(" [ELSE\n");
298: printf(" (expression n)]\n");
299: printf(" END\n\n");
300:
301: printf(" SELECT (expression test)\n");
302: printf(" CASE (clause 1) THEN (expression 1) END\n");
303: printf(" CASE (clause 2) THEN (expression 2) END\n");
304: printf(" ...\n");
305: printf(" CASE (clause n) THEN (expression n) END\n");
306: printf(" DEFAULT\n");
307: printf(" (expression)\n");
308: printf(" END\n\n");
309:
310: printf(" SELECT (expression test)\n");
311: printf(" CASE (clause 1) THEN (expression 1) END\n");
312: printf(" (expression)\n");
313: printf(" CASE (clause 2) THEN (expression 2) END\n");
314: printf(" END\n");
315:
316: return;
317: }
318: else if ((*s_etat_processus).test_instruction == 'Y')
319: {
320: (*s_etat_processus).nombre_arguments = -1;
321: return;
322: }
323:
324: if (((*(*s_etat_processus).l_base_pile_systeme).clause != 'I') &&
325: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'T') &&
326: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'R') &&
327: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'X') &&
328: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'C') &&
329: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'K'))
330: {
331: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_condition;
332: return;
333: }
334:
335: /*
336: * Traitement des erreurs
337: */
338:
339: if (((*(*s_etat_processus).l_base_pile_systeme).clause == 'R') ||
340: ((*(*s_etat_processus).l_base_pile_systeme).clause == 'X'))
341: {
342: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
343: {
344: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
345: return;
346: }
347:
348: if ((*(*s_etat_processus).l_base_pile_systeme).clause == 'R')
349: {
350:
351: /*
352: * Erreur à traiter : on saute jusques au ELSE ou au END
353: * correspondant.
354: */
355:
356: (*((integer8 *) (*s_objet).objet)) = 0;
357: }
358: else
359: {
360: (*((integer8 *) (*s_objet).objet)) = -1;
361: }
362:
363: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
364: s_objet) == d_erreur)
365: {
366: return;
367: }
368:
369: (*s_etat_processus).arret_si_exception = (*(*s_etat_processus)
370: .l_base_pile_systeme).arret_si_exception;
371: }
372:
373: /*
374: * Traitement standard de l'instruction 'THEN'
375: */
376:
377: if (test_cfsf(s_etat_processus, 31) == d_vrai)
378: {
379: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
380: {
381: return;
382: }
383: }
384:
385: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
386: &s_objet) == d_erreur)
387: {
388: return;
389: }
390:
391: if (((*s_objet).type == INT) || ((*s_objet).type == REL))
392: {
393: if ((*s_objet).type == INT)
394: {
395: condition = ((*((integer8 *) (*s_objet).objet)) == 0)
396: ? d_faux : d_vrai;
397: }
398: else
399: {
400: condition = ((*((real8 *) (*s_objet).objet)) == 0)
401: ? d_faux : d_vrai;
402: }
403:
404: if (condition == d_vrai)
405: {
406:
407: /*
408: * condition == d_vrai : exécution de ce qui se trouve entre
409: * THEN et ELSE ou END.
410: */
411:
412: if (((*(*s_etat_processus).l_base_pile_systeme).clause ==
413: 'I') || ((*(*s_etat_processus).l_base_pile_systeme).clause
414: == 'X'))
415: {
416: (*(*s_etat_processus).l_base_pile_systeme).clause = 'T';
417: }
418: else
419: {
420: if ((*s_etat_processus).l_base_pile_systeme == NULL)
421: {
422: (*s_etat_processus).erreur_systeme = d_es_pile_vide;
423: return;
424: }
425:
426: l_element_courant = (*(*s_etat_processus).l_base_pile_systeme)
427: .suivant;
428:
429: while(l_element_courant != NULL)
430: {
431: if ((*l_element_courant).clause == 'K')
432: {
433: (*l_element_courant).clause = 'Q';
434: break;
435: }
436:
437: l_element_courant = (*l_element_courant).suivant;
438: }
439: }
440: }
441: else
442: {
443: /*
444: * condition == d_faux : saut à END ou exécution de ce qui se
445: * trouve entre ELSE et END
446: */
447:
448: if ((*(*s_etat_processus).l_base_pile_systeme).clause != 'T')
449: {
450: /*
451: * Traitement de ELSEIF
452: */
453:
454: if (((*(*s_etat_processus).l_base_pile_systeme).clause !=
455: 'K') && ((*(*s_etat_processus).l_base_pile_systeme)
456: .clause != 'C'))
457: {
458: (*(*s_etat_processus).l_base_pile_systeme).clause = 'E';
459: }
460: }
461:
462: niveau = 0;
463: drapeau_fin = d_faux;
464:
465: if ((*s_etat_processus).mode_execution_programme == 'Y')
466: {
467: tampon = (*s_etat_processus).instruction_courante;
468:
469: do
470: {
471: if (recherche_instruction_suivante(s_etat_processus)
472: == d_erreur)
473: {
474: liberation(s_etat_processus, s_objet);
475:
476: if ((*s_etat_processus).instruction_courante != NULL)
477: {
478: free((*s_etat_processus).instruction_courante);
479: }
480:
481: (*s_etat_processus).instruction_courante = tampon;
482: (*s_etat_processus).erreur_execution =
483: d_ex_erreur_traitement_condition;
484: return;
485: }
486:
487: if ((instruction_majuscule = conversion_majuscule(
488: (*s_etat_processus).instruction_courante)) == NULL)
489: {
490: liberation(s_etat_processus, s_objet);
491:
492: free((*s_etat_processus).instruction_courante);
493: (*s_etat_processus).instruction_courante = tampon;
494: (*s_etat_processus).erreur_systeme =
495: d_es_allocation_memoire;
496: return;
497: }
498:
499: if (niveau == 0)
500: {
501: if (((*(*s_etat_processus).l_base_pile_systeme)
502: .clause != 'K') && ((*(*s_etat_processus)
503: .l_base_pile_systeme) .clause != 'C'))
504: {
505:
506: /*
507: * Traitement de IF/THEN/ELSEIF/THEN/ELSE/END
508: */
509:
510: if ((strcmp(instruction_majuscule, "END") == 0) ||
511: (strcmp(instruction_majuscule, "ELSE")
512: == 0) || (strcmp(instruction_majuscule,
513: "ELSEIF") == 0))
514: {
515: (*s_etat_processus).position_courante
516: -= (integer8) (strlen(
517: instruction_majuscule) + 1);
518: drapeau_fin = d_vrai;
519: }
520: else
521: {
522: drapeau_fin = d_faux;
523: }
524: }
525: else
526: {
527: /*
528: * Traitement de CASE/THEN/END
529: */
530:
531: if (strcmp(instruction_majuscule, "ELSE") == 0)
532: {
533: liberation(s_etat_processus, s_objet);
534:
535: free((*s_etat_processus).instruction_courante);
536: free(instruction_majuscule);
537:
538: (*s_etat_processus).instruction_courante =
539: tampon;
540: (*s_etat_processus).erreur_execution =
541: d_ex_erreur_traitement_condition;
542: return;
543: }
544: else if (strcmp(instruction_majuscule, "END") == 0)
545: {
546: instruction_end(s_etat_processus);
547: drapeau_fin = d_vrai;
548: }
549: else
550: {
551: drapeau_fin = d_faux;
552: }
553: }
554: }
555: else
556: {
557: drapeau_fin = d_faux;
558: }
559:
560: if ((strcmp(instruction_majuscule, "CASE") == 0) ||
561: (strcmp(instruction_majuscule, "DO") == 0) ||
562: (strcmp(instruction_majuscule, "IF") == 0) ||
563: (strcmp(instruction_majuscule, "IFERR") == 0) ||
564: (strcmp(instruction_majuscule, "SELECT") == 0) ||
565: (strcmp(instruction_majuscule, "WHILE") == 0))
566: {
567: niveau++;
568: }
569: else if (strcmp(instruction_majuscule, "END") == 0)
570: {
571: niveau--;
572: }
573:
574: free(instruction_majuscule);
575: free((*s_etat_processus).instruction_courante);
576: } while(drapeau_fin == d_faux);
577:
578: (*s_etat_processus).instruction_courante = tampon;
579: }
580: else
581: {
582: /*
583: * Vérification du pointeur de prédiction de saut.
584: */
585:
586: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
587: .expression_courante).donnee).mutex)) != 0)
588: {
589: (*s_etat_processus).erreur_systeme = d_es_processus;
590: return;
591: }
592:
593: if ((*((struct_fonction *) (*(*(*s_etat_processus)
594: .expression_courante).donnee).objet)).prediction_saut
595: != NULL)
596: {
597: s_registre = (*s_etat_processus).expression_courante;
598:
599: (*s_etat_processus).expression_courante =
600: (struct_liste_chainee *)
601: (*((struct_fonction *) (*(*(*s_etat_processus)
602: .expression_courante).donnee).objet))
603: .prediction_saut;
604: fonction = (*((struct_fonction *)
605: (*(*(*s_etat_processus).expression_courante)
606: .donnee).objet)).fonction;
607: execution = (*((struct_fonction *)
608: (*(*s_registre).donnee).objet))
609: .prediction_execution;
610:
611: if (pthread_mutex_unlock(&((*(*s_registre).donnee).mutex))
612: != 0)
613: {
614: (*s_etat_processus).erreur_systeme = d_es_processus;
615: return;
616: }
617:
618: if (execution == d_vrai)
619: {
620: fonction(s_etat_processus);
621: }
622: }
623: else
624: {
625: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
626: .expression_courante).donnee).mutex)) != 0)
627: {
628: (*s_etat_processus).erreur_systeme = d_es_processus;
629: return;
630: }
631:
632: s_registre = (*s_etat_processus).expression_courante;
633: execution = d_faux;
634:
635: do
636: {
637: if (((*s_etat_processus).expression_courante =
638: (*(*s_etat_processus).expression_courante)
639: .suivant) == NULL)
640: {
641: liberation(s_etat_processus, s_objet);
642: (*s_etat_processus).erreur_execution =
643: d_ex_erreur_traitement_condition;
644: return;
645: }
646:
647: if ((*(*(*s_etat_processus).expression_courante)
648: .donnee).type == FCT)
649: {
650: fonction = (*((struct_fonction *)
651: (*(*(*s_etat_processus).expression_courante)
652: .donnee).objet)).fonction;
653:
654: if (niveau == 0)
655: {
656: if (((*(*s_etat_processus).l_base_pile_systeme)
657: .clause != 'K') &&
658: ((*(*s_etat_processus)
659: .l_base_pile_systeme).clause != 'C'))
660: {
661: /*
662: * Traitement de IF/THEN/ELSEIF/THEN/
663: * ELSE/END
664: */
665:
666: if ((fonction == instruction_end) ||
667: (fonction == instruction_else) ||
668: (fonction == instruction_elseif))
669: {
670: fonction(s_etat_processus);
671: execution = d_vrai;
672: drapeau_fin = d_vrai;
673: }
674: else
675: {
676: drapeau_fin = d_faux;
677: }
678: }
679: else
680: {
681: /*
682: * Traitement de CASE/THEN/END
683: */
684:
685: if (fonction == instruction_else)
686: {
687: liberation(s_etat_processus, s_objet);
688:
689: if ((drapeau_fin == d_faux) &&
690: ((*s_etat_processus)
691: .expression_courante != NULL))
692: {
693: (*s_etat_processus)
694: .expression_courante
695: = (*(*s_etat_processus)
696: .expression_courante)
697: .suivant;
698: }
699:
700: (*s_etat_processus).erreur_execution =
701: d_ex_erreur_traitement_condition;
702: return;
703: }
704: else if (fonction == instruction_end)
705: {
706: fonction(s_etat_processus);
707: execution = d_vrai;
708: drapeau_fin = d_vrai;
709: }
710: else
711: {
712: drapeau_fin = d_faux;
713: }
714: }
715: }
716: else
717: {
718: drapeau_fin = d_faux;
719: }
720:
721: if ((fonction == instruction_case) ||
722: (fonction == instruction_do) ||
723: (fonction == instruction_if) ||
724: (fonction == instruction_iferr) ||
725: (fonction == instruction_select) ||
726: (fonction == instruction_while))
727: {
728: niveau++;
729: }
730: else if (fonction == instruction_end)
731: {
732: niveau--;
733: }
734: }
735: } while(drapeau_fin == d_faux);
736:
737: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
738: .expression_courante).donnee).mutex)) != 0)
739: {
740: (*s_etat_processus).erreur_systeme = d_es_processus;
741: return;
742: }
743:
744: (*((struct_fonction *) (*(*s_registre).donnee).objet))
745: .prediction_saut = (*s_etat_processus)
746: .expression_courante;
747: (*((struct_fonction *) (*(*s_registre).donnee).objet))
748: .prediction_execution = execution;
749:
750: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
751: .expression_courante).donnee).mutex)) != 0)
752: {
753: (*s_etat_processus).erreur_systeme = d_es_processus;
754: return;
755: }
756: }
757: }
758: }
759: }
760: else
761: {
762: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
763: return;
764: }
765:
766: liberation(s_etat_processus, s_objet);
767: return;
768: }
769:
770:
771: /*
772: ================================================================================
773: Fonction 'tan'
774: ================================================================================
775: Entrées : pointeur sur une structure struct_processus
776: --------------------------------------------------------------------------------
777: Sorties :
778: --------------------------------------------------------------------------------
779: Effets de bord : néant
780: ================================================================================
781: */
782:
783: void
784: instruction_tan(struct_processus *s_etat_processus)
785: {
786: real8 angle;
787:
788: integer4 erreur;
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: (*s_etat_processus).erreur_execution = d_ex;
798:
799: if ((*s_etat_processus).affichage_arguments == 'Y')
800: {
801: printf("\n TAN ");
802:
803: if ((*s_etat_processus).langue == 'F')
804: {
805: printf("(tangente)\n\n");
806: }
807: else
808: {
809: printf("(tangent)\n\n");
810: }
811:
812: printf(" 1: %s, %s\n", d_INT, d_REL);
813: printf("-> 1: %s\n\n", d_REL);
814:
815: printf(" 1: %s\n", d_CPL);
816: printf("-> 1: %s\n\n", d_CPL);
817:
818: printf(" 1: %s, %s\n", d_NOM, d_ALG);
819: printf("-> 1: %s\n\n", d_ALG);
820:
821: printf(" 1: %s\n", d_RPN);
822: printf("-> 1: %s\n", d_RPN);
823:
824: return;
825: }
826: else if ((*s_etat_processus).test_instruction == 'Y')
827: {
828: (*s_etat_processus).nombre_arguments = 1;
829: return;
830: }
831:
832: if (test_cfsf(s_etat_processus, 31) == d_vrai)
833: {
834: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
835: {
836: return;
837: }
838: }
839:
840: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
841: &s_objet_argument) == d_erreur)
842: {
843: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
844: return;
845: }
846:
847: /*
848: --------------------------------------------------------------------------------
849: Tangente d'un entier ou d'un réel
850: --------------------------------------------------------------------------------
851: */
852:
853: if (((*s_objet_argument).type == INT) ||
854: ((*s_objet_argument).type == REL))
855: {
856: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
857: {
858: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
859: return;
860: }
861:
862: if ((*s_objet_argument).type == INT)
863: {
864: angle = (real8) (*((integer8 *) (*s_objet_argument).objet));
865: }
866: else
867: {
868: angle = (*((real8 *) (*s_objet_argument).objet));
869: }
870:
871: if (test_cfsf(s_etat_processus, 60) == d_faux)
872: {
873: conversion_degres_vers_radians(&angle);
874: }
875:
876: if ((cos(angle) == 0) && (test_cfsf(s_etat_processus, 59) == d_vrai))
877: {
878: liberation(s_etat_processus, s_objet_argument);
879: liberation(s_etat_processus, s_objet_resultat);
880:
881: (*s_etat_processus).exception = d_ep_division_par_zero;
882: return;
883: }
884:
885: (*((real8 *) (*s_objet_resultat).objet)) = tan(angle);
886: }
887:
888: /*
889: --------------------------------------------------------------------------------
890: Tangente d'un complexe
891: --------------------------------------------------------------------------------
892: */
893:
894: else if ((*s_objet_argument).type == CPL)
895: {
896: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
897: {
898: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
899: return;
900: }
901:
902: f77tan_((struct_complexe16 *) (*s_objet_argument).objet,
903: (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
904:
905: if (erreur != 0)
906: {
907: liberation(s_etat_processus, s_objet_argument);
908: liberation(s_etat_processus, s_objet_resultat);
909:
910: (*s_etat_processus).exception = d_ep_division_par_zero;
911: return;
912: }
913: }
914:
915: /*
916: --------------------------------------------------------------------------------
917: Tangente d'un nom
918: --------------------------------------------------------------------------------
919: */
920:
921: else if ((*s_objet_argument).type == NOM)
922: {
923: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
924: {
925: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
926: return;
927: }
928:
929: if (((*s_objet_resultat).objet =
930: allocation_maillon(s_etat_processus)) == NULL)
931: {
932: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
933: return;
934: }
935:
936: l_element_courant = (*s_objet_resultat).objet;
937:
938: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
939: == NULL)
940: {
941: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
942: return;
943: }
944:
945: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
946: .nombre_arguments = 0;
947: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
948: .fonction = instruction_vers_niveau_superieur;
949:
950: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
951: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
952: {
953: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
954: return;
955: }
956:
957: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
958: .nom_fonction, "<<");
959:
960: if (((*l_element_courant).suivant =
961: allocation_maillon(s_etat_processus)) == NULL)
962: {
963: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
964: return;
965: }
966:
967: l_element_courant = (*l_element_courant).suivant;
968: (*l_element_courant).donnee = s_objet_argument;
969:
970: if (((*l_element_courant).suivant =
971: allocation_maillon(s_etat_processus)) == NULL)
972: {
973: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
974: return;
975: }
976:
977: l_element_courant = (*l_element_courant).suivant;
978:
979: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
980: == NULL)
981: {
982: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
983: return;
984: }
985:
986: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
987: .nombre_arguments = 1;
988: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
989: .fonction = instruction_tan;
990:
991: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
992: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
993: {
994: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
995: return;
996: }
997:
998: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
999: .nom_fonction, "TAN");
1000:
1001: if (((*l_element_courant).suivant =
1002: allocation_maillon(s_etat_processus)) == NULL)
1003: {
1004: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1005: return;
1006: }
1007:
1008: l_element_courant = (*l_element_courant).suivant;
1009:
1010: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1011: == NULL)
1012: {
1013: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1014: return;
1015: }
1016:
1017: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1018: .nombre_arguments = 0;
1019: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1020: .fonction = instruction_vers_niveau_inferieur;
1021:
1022: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1023: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1024: {
1025: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1026: return;
1027: }
1028:
1029: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1030: .nom_fonction, ">>");
1031:
1032: (*l_element_courant).suivant = NULL;
1033: s_objet_argument = NULL;
1034: }
1035:
1036: /*
1037: --------------------------------------------------------------------------------
1038: Tangente d'une expression
1039: --------------------------------------------------------------------------------
1040: */
1041:
1042: else if (((*s_objet_argument).type == ALG) ||
1043: ((*s_objet_argument).type == RPN))
1044: {
1045: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
1046: 'N')) == NULL)
1047: {
1048: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1049: return;
1050: }
1051:
1052: l_element_courant = (struct_liste_chainee *)
1053: (*s_copie_argument).objet;
1054: l_element_precedent = l_element_courant;
1055:
1056: while((*l_element_courant).suivant != NULL)
1057: {
1058: l_element_precedent = l_element_courant;
1059: l_element_courant = (*l_element_courant).suivant;
1060: }
1061:
1062: if (((*l_element_precedent).suivant =
1063: allocation_maillon(s_etat_processus)) == NULL)
1064: {
1065: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1066: return;
1067: }
1068:
1069: if (((*(*l_element_precedent).suivant).donnee =
1070: allocation(s_etat_processus, FCT)) == NULL)
1071: {
1072: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1073: return;
1074: }
1075:
1076: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1077: .donnee).objet)).nombre_arguments = 1;
1078: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1079: .donnee).objet)).fonction = instruction_tan;
1080:
1081: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1082: .suivant).donnee).objet)).nom_fonction =
1083: malloc(4 * sizeof(unsigned char))) == NULL)
1084: {
1085: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1086: return;
1087: }
1088:
1089: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1090: .suivant).donnee).objet)).nom_fonction, "TAN");
1091:
1092: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1093:
1094: s_objet_resultat = s_copie_argument;
1095: }
1096:
1097: /*
1098: --------------------------------------------------------------------------------
1099: Réalisation impossible de la fonction tangente
1100: --------------------------------------------------------------------------------
1101: */
1102:
1103: else
1104: {
1105: liberation(s_etat_processus, s_objet_argument);
1106:
1107: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1108: return;
1109: }
1110:
1111: liberation(s_etat_processus, s_objet_argument);
1112:
1113: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1114: s_objet_resultat) == d_erreur)
1115: {
1116: return;
1117: }
1118:
1119: return;
1120: }
1121:
1122:
1123: /*
1124: ================================================================================
1125: Fonction 'tanh'
1126: ================================================================================
1127: Entrées : pointeur sur une structure struct_processus
1128: --------------------------------------------------------------------------------
1129: Sorties :
1130: --------------------------------------------------------------------------------
1131: Effets de bord : néant
1132: ================================================================================
1133: */
1134:
1135: void
1136: instruction_tanh(struct_processus *s_etat_processus)
1137: {
1138: real8 argument;
1139:
1140: integer4 erreur;
1141:
1142: struct_liste_chainee *l_element_courant;
1143: struct_liste_chainee *l_element_precedent;
1144:
1145: struct_objet *s_copie_argument;
1146: struct_objet *s_objet_argument;
1147: struct_objet *s_objet_resultat;
1148:
1149: (*s_etat_processus).erreur_execution = d_ex;
1150:
1151: if ((*s_etat_processus).affichage_arguments == 'Y')
1152: {
1153: printf("\n TANH ");
1154:
1155: if ((*s_etat_processus).langue == 'F')
1156: {
1157: printf("(tangente hyperbolique)\n\n");
1158: }
1159: else
1160: {
1161: printf("(hyperbolic tangent)\n\n");
1162: }
1163:
1164: printf(" 1: %s, %s\n", d_INT, d_REL);
1165: printf("-> 1: %s\n\n", d_INT);
1166:
1167: printf(" 1: %s\n", d_CPL);
1168: printf("-> 1: %s\n\n", d_CPL);
1169:
1170: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1171: printf("-> 1: %s\n\n", d_ALG);
1172:
1173: printf(" 1: %s\n", d_RPN);
1174: printf("-> 1: %s\n", d_RPN);
1175:
1176: return;
1177: }
1178: else if ((*s_etat_processus).test_instruction == 'Y')
1179: {
1180: (*s_etat_processus).nombre_arguments = 1;
1181: return;
1182: }
1183:
1184: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1185: {
1186: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1187: {
1188: return;
1189: }
1190: }
1191:
1192: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1193: &s_objet_argument) == d_erreur)
1194: {
1195: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1196: return;
1197: }
1198:
1199: /*
1200: --------------------------------------------------------------------------------
1201: Tangente hyperbolique d'un entier ou d'un réel
1202: --------------------------------------------------------------------------------
1203: */
1204:
1205: if (((*s_objet_argument).type == INT) ||
1206: ((*s_objet_argument).type == REL))
1207: {
1208: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1209: {
1210: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1211: return;
1212: }
1213:
1214: if ((*s_objet_argument).type == INT)
1215: {
1216: argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
1217: }
1218: else
1219: {
1220: argument = (*((real8 *) (*s_objet_argument).objet));
1221: }
1222:
1223: (*((real8 *) (*s_objet_resultat).objet)) = tanh(argument);
1224: }
1225:
1226: /*
1227: --------------------------------------------------------------------------------
1228: Tangente hyperbolique d'un complexe
1229: --------------------------------------------------------------------------------
1230: */
1231:
1232: else if ((*s_objet_argument).type == CPL)
1233: {
1234: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
1235: {
1236: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1237: return;
1238: }
1239:
1240: f77tanh_((struct_complexe16 *) (*s_objet_argument).objet,
1241: (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
1242:
1243: if (erreur != 0)
1244: {
1245: liberation(s_etat_processus, s_objet_argument);
1246: liberation(s_etat_processus, s_objet_resultat);
1247:
1248: (*s_etat_processus).exception = d_ep_division_par_zero;
1249: return;
1250: }
1251: }
1252:
1253: /*
1254: --------------------------------------------------------------------------------
1255: Tangente hyperbolique d'un nom
1256: --------------------------------------------------------------------------------
1257: */
1258:
1259: else if ((*s_objet_argument).type == NOM)
1260: {
1261: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1262: {
1263: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1264: return;
1265: }
1266:
1267: if (((*s_objet_resultat).objet =
1268: allocation_maillon(s_etat_processus)) == NULL)
1269: {
1270: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1271: return;
1272: }
1273:
1274: l_element_courant = (*s_objet_resultat).objet;
1275:
1276: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1277: == NULL)
1278: {
1279: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1280: return;
1281: }
1282:
1283: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1284: .nombre_arguments = 0;
1285: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1286: .fonction = instruction_vers_niveau_superieur;
1287:
1288: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1289: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1290: {
1291: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1292: return;
1293: }
1294:
1295: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1296: .nom_fonction, "<<");
1297:
1298: if (((*l_element_courant).suivant =
1299: allocation_maillon(s_etat_processus)) == NULL)
1300: {
1301: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1302: return;
1303: }
1304:
1305: l_element_courant = (*l_element_courant).suivant;
1306: (*l_element_courant).donnee = s_objet_argument;
1307:
1308: if (((*l_element_courant).suivant =
1309: allocation_maillon(s_etat_processus)) == NULL)
1310: {
1311: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1312: return;
1313: }
1314:
1315: l_element_courant = (*l_element_courant).suivant;
1316:
1317: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1318: == NULL)
1319: {
1320: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1321: return;
1322: }
1323:
1324: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1325: .nombre_arguments = 1;
1326: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1327: .fonction = instruction_tanh;
1328:
1329: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1330: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
1331: {
1332: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1333: return;
1334: }
1335:
1336: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1337: .nom_fonction, "TANH");
1338:
1339: if (((*l_element_courant).suivant =
1340: allocation_maillon(s_etat_processus)) == NULL)
1341: {
1342: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1343: return;
1344: }
1345:
1346: l_element_courant = (*l_element_courant).suivant;
1347:
1348: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1349: == NULL)
1350: {
1351: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1352: return;
1353: }
1354:
1355: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1356: .nombre_arguments = 0;
1357: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1358: .fonction = instruction_vers_niveau_inferieur;
1359:
1360: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1361: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1362: {
1363: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1364: return;
1365: }
1366:
1367: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1368: .nom_fonction, ">>");
1369:
1370: (*l_element_courant).suivant = NULL;
1371: s_objet_argument = NULL;
1372: }
1373:
1374: /*
1375: --------------------------------------------------------------------------------
1376: Tangente hyperbolique d'une expression
1377: --------------------------------------------------------------------------------
1378: */
1379:
1380: else if (((*s_objet_argument).type == ALG) ||
1381: ((*s_objet_argument).type == RPN))
1382: {
1383: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
1384: 'N')) == NULL)
1385: {
1386: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1387: return;
1388: }
1389:
1390: l_element_courant = (struct_liste_chainee *)
1391: (*s_copie_argument).objet;
1392: l_element_precedent = l_element_courant;
1393:
1394: while((*l_element_courant).suivant != NULL)
1395: {
1396: l_element_precedent = l_element_courant;
1397: l_element_courant = (*l_element_courant).suivant;
1398: }
1399:
1400: if (((*l_element_precedent).suivant =
1401: allocation_maillon(s_etat_processus)) == NULL)
1402: {
1403: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1404: return;
1405: }
1406:
1407: if (((*(*l_element_precedent).suivant).donnee =
1408: allocation(s_etat_processus, FCT)) == NULL)
1409: {
1410: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1411: return;
1412: }
1413:
1414: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1415: .donnee).objet)).nombre_arguments = 1;
1416: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1417: .donnee).objet)).fonction = instruction_tanh;
1418:
1419: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1420: .suivant).donnee).objet)).nom_fonction =
1421: malloc(5 * sizeof(unsigned char))) == NULL)
1422: {
1423: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1424: return;
1425: }
1426:
1427: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1428: .suivant).donnee).objet)).nom_fonction, "TANH");
1429:
1430: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1431:
1432: s_objet_resultat = s_copie_argument;
1433: }
1434:
1435: /*
1436: --------------------------------------------------------------------------------
1437: Réalisation impossible de la fonction tangente hyperbolique
1438: --------------------------------------------------------------------------------
1439: */
1440:
1441: else
1442: {
1443: liberation(s_etat_processus, s_objet_argument);
1444:
1445: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1446: return;
1447: }
1448:
1449: liberation(s_etat_processus, s_objet_argument);
1450:
1451: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1452: s_objet_resultat) == d_erreur)
1453: {
1454: return;
1455: }
1456:
1457: return;
1458: }
1459:
1460:
1461: /*
1462: ================================================================================
1463: Fonction 'true'
1464: ================================================================================
1465: Entrées : structure processus
1466: --------------------------------------------------------------------------------
1467: Sorties :
1468: --------------------------------------------------------------------------------
1469: Effets de bord : néant
1470: ================================================================================
1471: */
1472:
1473: void
1474: instruction_true(struct_processus *s_etat_processus)
1475: {
1476: struct_objet *s_objet;
1477:
1478: if ((*s_etat_processus).affichage_arguments == 'Y')
1479: {
1480: printf("\n TRUE ");
1481:
1482: if ((*s_etat_processus).langue == 'F')
1483: {
1484: printf("(valeur vraie)\n\n");
1485: }
1486: else
1487: {
1488: printf("(true value)\n\n");
1489: }
1490:
1491: printf("-> 1: %s\n", d_INT);
1492:
1493: return;
1494: }
1495: else if ((*s_etat_processus).test_instruction == 'Y')
1496: {
1497: (*s_etat_processus).nombre_arguments = -1;
1498: return;
1499: }
1500:
1501: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
1502: {
1503: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1504: return;
1505: }
1506:
1507: (*((integer8 *) (*s_objet).objet)) = -1;
1508:
1509: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1510: s_objet) == d_erreur)
1511: {
1512: return;
1513: }
1514:
1515: return;
1516: }
1517:
1518: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>