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