![[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|
Return to instructions_t1.c CVS log | Up to [local] / rpl / src |
1.1 bertrand 1: /*
2: ================================================================================
1.9 bertrand 3: RPL/2 (R) version 4.0.17
1.1 bertrand 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:
1.10 bertrand 217: struct_liste_pile_systeme *l_element_courant;
218:
1.1 bertrand 219: struct_objet *s_objet;
220:
221: unsigned char *instruction_majuscule;
222: unsigned char *tampon;
223:
224: unsigned long niveau;
225:
226: void (*fonction)();
227:
228: (*s_etat_processus).erreur_execution = d_ex;
229:
230: if ((*s_etat_processus).affichage_arguments == 'Y')
231: {
232: printf("\n THEN ");
233:
234: if ((*s_etat_processus).langue == 'F')
235: {
236: printf("(structure de contrôle)\n\n");
237: printf(" Utilisation :\n\n");
238: }
239: else
240: {
241: printf("(control statement)\n\n");
242: printf(" Usage:\n\n");
243: }
244:
245: printf(" IF(ERR)\n");
246: printf(" (expression test 1)\n");
247: printf(" THEN\n");
248: printf(" (expression 1)\n");
249: printf(" [ELSEIF\n");
250: printf(" (expression test 2)\n");
251: printf(" THEN\n");
252: printf(" (expression 2)]\n");
253: printf(" ...\n");
254: printf(" [ELSE\n");
255: printf(" (expression n)]\n");
256: printf(" END\n\n");
257:
258: printf(" SELECT (expression test)\n");
259: printf(" CASE (clause 1) THEN (expression 1) END\n");
260: printf(" CASE (clause 2) THEN (expression 2) END\n");
261: printf(" ...\n");
262: printf(" CASE (clause n) THEN (expression n) END\n");
263: printf(" DEFAULT\n");
264: printf(" (expression)\n");
265: printf(" END\n\n");
266:
267: printf(" SELECT (expression test)\n");
268: printf(" CASE (clause 1) THEN (expression 1) END\n");
269: printf(" (expression)\n");
270: printf(" CASE (clause 2) THEN (expression 2) END\n");
271: printf(" END\n");
272:
273: return;
274: }
275: else if ((*s_etat_processus).test_instruction == 'Y')
276: {
277: (*s_etat_processus).nombre_arguments = -1;
278: return;
279: }
280:
281: if (((*(*s_etat_processus).l_base_pile_systeme).clause != 'I') &&
282: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'T') &&
283: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'R') &&
284: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'X') &&
285: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'C') &&
286: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'K'))
287: {
288: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_condition;
289: return;
290: }
291:
292: /*
293: * Traitement des erreurs
294: */
295:
296: if (((*(*s_etat_processus).l_base_pile_systeme).clause == 'R') ||
297: ((*(*s_etat_processus).l_base_pile_systeme).clause == 'X'))
298: {
299: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
300: {
301: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
302: return;
303: }
304:
305: if ((*(*s_etat_processus).l_base_pile_systeme).clause == 'R')
306: {
307:
308: /*
309: * Erreur à traiter : on saute jusques au ELSE ou au END
310: * correspondant.
311: */
312:
313: (*((integer8 *) (*s_objet).objet)) = 0;
314: }
315: else
316: {
317: (*((integer8 *) (*s_objet).objet)) = -1;
318: }
319:
320: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
321: s_objet) == d_erreur)
322: {
323: return;
324: }
325:
326: (*s_etat_processus).arret_si_exception = (*(*s_etat_processus)
327: .l_base_pile_systeme).arret_si_exception;
328: }
329:
330: /*
331: * Traitement standard de l'instruction 'THEN'
332: */
333:
334: if (test_cfsf(s_etat_processus, 31) == d_vrai)
335: {
336: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
337: {
338: return;
339: }
340: }
341:
342: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
343: &s_objet) == d_erreur)
344: {
345: return;
346: }
347:
348: if (((*s_objet).type == INT) ||
349: ((*s_objet).type == REL))
350: {
351: if ((*s_objet).type == INT)
352: {
353: condition = ((*((integer8 *) (*s_objet).objet)) == 0)
354: ? d_faux : d_vrai;
355: }
356: else
357: {
358: condition = ((*((real8 *) (*s_objet).objet)) == 0)
359: ? d_faux : d_vrai;
360: }
361:
362: if (condition == d_vrai)
363: {
364:
365: /*
366: * condition == d_vrai : exécution de ce qui se trouve entre
367: * THEN et ELSE ou END.
368: */
369:
1.11 ! bertrand 370: if (((*(*s_etat_processus).l_base_pile_systeme).clause ==
! 371: 'I') || ((*(*s_etat_processus).l_base_pile_systeme).clause
! 372: == 'R'))
1.1 bertrand 373: {
374: (*(*s_etat_processus).l_base_pile_systeme).clause = 'T';
375: }
376: else
377: {
1.10 bertrand 378: if ((*s_etat_processus).l_base_pile_systeme == NULL)
379: {
380: (*s_etat_processus).erreur_systeme = d_es_pile_vide;
381: return;
382: }
383:
384: l_element_courant = (*(*s_etat_processus).l_base_pile_systeme)
385: .suivant;
386:
387: while(l_element_courant != NULL)
388: {
389: if ((*l_element_courant).clause == 'K')
390: {
391: (*l_element_courant).clause = 'Q';
392: break;
393: }
394:
395: l_element_courant = (*l_element_courant).suivant;
396: }
1.1 bertrand 397: }
398: }
399: else
400: {
401: /*
402: * condition == d_faux : saut à END ou exécution de ce qui se
403: * trouve entre ELSE et END
404: */
405:
406: if ((*(*s_etat_processus).l_base_pile_systeme).clause != 'T')
407: {
408: /*
409: * Traitement de ELSEIF
410: */
411:
412: if (((*(*s_etat_processus).l_base_pile_systeme).clause !=
413: 'K') && ((*(*s_etat_processus).l_base_pile_systeme)
414: .clause != 'C'))
415: {
416: (*(*s_etat_processus).l_base_pile_systeme).clause = 'E';
417: }
418: }
419:
420: niveau = 0;
421: drapeau_fin = d_faux;
422:
423: if ((*s_etat_processus).mode_execution_programme == 'Y')
424: {
425: tampon = (*s_etat_processus).instruction_courante;
426:
427: do
428: {
429: if (recherche_instruction_suivante(s_etat_processus)
430: == d_erreur)
431: {
432: liberation(s_etat_processus, s_objet);
433:
434: if ((*s_etat_processus).instruction_courante != NULL)
435: {
436: free((*s_etat_processus).instruction_courante);
437: }
438:
439: (*s_etat_processus).instruction_courante = tampon;
440: (*s_etat_processus).erreur_execution =
441: d_ex_erreur_traitement_condition;
442: return;
443: }
444:
445: if ((instruction_majuscule = conversion_majuscule(
446: (*s_etat_processus).instruction_courante)) == NULL)
447: {
448: liberation(s_etat_processus, s_objet);
449:
450: free((*s_etat_processus).instruction_courante);
451: (*s_etat_processus).instruction_courante = tampon;
452: (*s_etat_processus).erreur_systeme =
453: d_es_allocation_memoire;
454: return;
455: }
456:
457: if (niveau == 0)
458: {
459: if (((*(*s_etat_processus).l_base_pile_systeme)
460: .clause != 'K') && ((*(*s_etat_processus)
461: .l_base_pile_systeme) .clause != 'C'))
462: {
463:
464: /*
465: * Traitement de IF/THEN/ELSEIF/THEN/ELSE/END
466: */
467:
468: if ((strcmp(instruction_majuscule, "END") == 0) ||
469: (strcmp(instruction_majuscule, "ELSE")
470: == 0) || (strcmp(instruction_majuscule,
471: "ELSEIF") == 0))
472: {
473: (*s_etat_processus).position_courante
474: -= (strlen(instruction_majuscule) + 1);
475: drapeau_fin = d_vrai;
476: }
477: else
478: {
479: drapeau_fin = d_faux;
480: }
481: }
482: else
483: {
484: /*
485: * Traitement de CASE/THEN/END
486: */
487:
488: if (strcmp(instruction_majuscule, "ELSE") == 0)
489: {
490: liberation(s_etat_processus, s_objet);
491:
492: free((*s_etat_processus).instruction_courante);
493: free(instruction_majuscule);
494:
495: (*s_etat_processus).instruction_courante =
496: tampon;
497: (*s_etat_processus).erreur_execution =
498: d_ex_erreur_traitement_condition;
499: return;
500: }
501: else if (strcmp(instruction_majuscule, "END") == 0)
502: {
1.10 bertrand 503: instruction_end(s_etat_processus);
1.1 bertrand 504: drapeau_fin = d_vrai;
505: }
506: else
507: {
508: drapeau_fin = d_faux;
509: }
510: }
511: }
512: else
513: {
514: drapeau_fin = d_faux;
515: }
516:
517: if ((strcmp(instruction_majuscule, "CASE") == 0) ||
518: (strcmp(instruction_majuscule, "DO") == 0) ||
519: (strcmp(instruction_majuscule, "IF") == 0) ||
520: (strcmp(instruction_majuscule, "IFERR") == 0) ||
521: (strcmp(instruction_majuscule, "SELECT") == 0) ||
522: (strcmp(instruction_majuscule, "WHILE") == 0))
523: {
524: niveau++;
525: }
526: else if (strcmp(instruction_majuscule, "END") == 0)
527: {
528: niveau--;
529: }
530:
531: free(instruction_majuscule);
532: free((*s_etat_processus).instruction_courante);
533: } while(drapeau_fin == d_faux);
534:
535: (*s_etat_processus).instruction_courante = tampon;
536: }
537: else
538: {
539: /*
540: * Vérification du pointeur de prédiction de saut.
541: */
542:
543: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
544: .expression_courante).donnee).mutex)) != 0)
545: {
546: (*s_etat_processus).erreur_systeme = d_es_processus;
547: return;
548: }
549:
550: if ((*((struct_fonction *) (*(*(*s_etat_processus)
551: .expression_courante).donnee).objet)).prediction_saut
552: != NULL)
553: {
554: s_registre = (*s_etat_processus).expression_courante;
555:
556: (*s_etat_processus).expression_courante =
557: (struct_liste_chainee *)
558: (*((struct_fonction *) (*(*(*s_etat_processus)
559: .expression_courante).donnee).objet))
560: .prediction_saut;
561: fonction = (*((struct_fonction *)
562: (*(*(*s_etat_processus).expression_courante)
563: .donnee).objet)).fonction;
564: execution = (*((struct_fonction *)
565: (*(*s_registre).donnee).objet))
566: .prediction_execution;
567:
568: if (pthread_mutex_unlock(&((*(*s_registre).donnee).mutex))
569: != 0)
570: {
571: (*s_etat_processus).erreur_systeme = d_es_processus;
572: return;
573: }
574:
575: if (execution == d_vrai)
576: {
577: fonction(s_etat_processus);
578: }
579: }
580: else
581: {
582: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
583: .expression_courante).donnee).mutex)) != 0)
584: {
585: (*s_etat_processus).erreur_systeme = d_es_processus;
586: return;
587: }
588:
589: s_registre = (*s_etat_processus).expression_courante;
590: execution = d_faux;
591:
592: do
593: {
594: if (((*s_etat_processus).expression_courante =
595: (*(*s_etat_processus).expression_courante)
596: .suivant) == NULL)
597: {
598: liberation(s_etat_processus, s_objet);
599: (*s_etat_processus).erreur_execution =
600: d_ex_erreur_traitement_condition;
601: return;
602: }
603:
604: if ((*(*(*s_etat_processus).expression_courante)
605: .donnee).type == FCT)
606: {
607: fonction = (*((struct_fonction *)
608: (*(*(*s_etat_processus).expression_courante)
609: .donnee).objet)).fonction;
610:
611: if (niveau == 0)
612: {
613: if (((*(*s_etat_processus).l_base_pile_systeme)
614: .clause != 'K') &&
615: ((*(*s_etat_processus)
1.10 bertrand 616: .l_base_pile_systeme).clause != 'C'))
1.1 bertrand 617: {
618: /*
619: * Traitement de IF/THEN/ELSEIF/THEN/
620: * ELSE/END
621: */
622:
623: if ((fonction == instruction_end) ||
624: (fonction == instruction_else) ||
625: (fonction == instruction_elseif))
626: {
627: fonction(s_etat_processus);
628: execution = d_vrai;
629: drapeau_fin = d_vrai;
630: }
631: else
632: {
633: drapeau_fin = d_faux;
634: }
635: }
636: else
637: {
638: /*
639: * Traitement de CASE/THEN/END
640: */
641:
642: if (fonction == instruction_else)
643: {
644: liberation(s_etat_processus, s_objet);
645:
646: if ((drapeau_fin == d_faux) &&
647: ((*s_etat_processus)
648: .expression_courante != NULL))
649: {
650: (*s_etat_processus)
651: .expression_courante
652: = (*(*s_etat_processus)
653: .expression_courante)
654: .suivant;
655: }
656:
657: (*s_etat_processus).erreur_execution =
658: d_ex_erreur_traitement_condition;
659: return;
660: }
661: else if (fonction == instruction_end)
662: {
1.10 bertrand 663: fonction(s_etat_processus);
664: execution = d_vrai;
1.1 bertrand 665: drapeau_fin = d_vrai;
666: }
667: else
668: {
669: drapeau_fin = d_faux;
670: }
671: }
672: }
673: else
674: {
675: drapeau_fin = d_faux;
676: }
677:
678: if ((fonction == instruction_case) ||
679: (fonction == instruction_do) ||
680: (fonction == instruction_if) ||
681: (fonction == instruction_iferr) ||
682: (fonction == instruction_select) ||
683: (fonction == instruction_while))
684: {
685: niveau++;
686: }
687: else if (fonction == instruction_end)
688: {
689: niveau--;
690: }
691: }
692: } while(drapeau_fin == d_faux);
693:
694: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
695: .expression_courante).donnee).mutex)) != 0)
696: {
697: (*s_etat_processus).erreur_systeme = d_es_processus;
698: return;
699: }
700:
701: (*((struct_fonction *) (*(*s_registre).donnee).objet))
702: .prediction_saut = (*s_etat_processus)
703: .expression_courante;
704: (*((struct_fonction *) (*(*s_registre).donnee).objet))
705: .prediction_execution = execution;
706:
707: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
708: .expression_courante).donnee).mutex)) != 0)
709: {
710: (*s_etat_processus).erreur_systeme = d_es_processus;
711: return;
712: }
713: }
714: }
715: }
716: }
717: else
718: {
719: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
720: return;
721: }
722:
723: liberation(s_etat_processus, s_objet);
724: return;
725: }
726:
727:
728: /*
729: ================================================================================
730: Fonction 'tan'
731: ================================================================================
732: Entrées : pointeur sur une structure struct_processus
733: --------------------------------------------------------------------------------
734: Sorties :
735: --------------------------------------------------------------------------------
736: Effets de bord : néant
737: ================================================================================
738: */
739:
740: void
741: instruction_tan(struct_processus *s_etat_processus)
742: {
743: real8 angle;
744:
745: integer4 erreur;
746:
747: struct_liste_chainee *l_element_courant;
748: struct_liste_chainee *l_element_precedent;
749:
750: struct_objet *s_copie_argument;
751: struct_objet *s_objet_argument;
752: struct_objet *s_objet_resultat;
753:
754: (*s_etat_processus).erreur_execution = d_ex;
755:
756: if ((*s_etat_processus).affichage_arguments == 'Y')
757: {
758: printf("\n TAN ");
759:
760: if ((*s_etat_processus).langue == 'F')
761: {
762: printf("(tangente)\n\n");
763: }
764: else
765: {
766: printf("(tangent)\n\n");
767: }
768:
769: printf(" 1: %s, %s\n", d_INT, d_REL);
770: printf("-> 1: %s\n\n", d_REL);
771:
772: printf(" 1: %s\n", d_CPL);
773: printf("-> 1: %s\n\n", d_CPL);
774:
775: printf(" 1: %s, %s\n", d_NOM, d_ALG);
776: printf("-> 1: %s\n\n", d_ALG);
777:
778: printf(" 1: %s\n", d_RPN);
779: printf("-> 1: %s\n", d_RPN);
780:
781: return;
782: }
783: else if ((*s_etat_processus).test_instruction == 'Y')
784: {
785: (*s_etat_processus).nombre_arguments = 1;
786: return;
787: }
788:
789: if (test_cfsf(s_etat_processus, 31) == d_vrai)
790: {
791: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
792: {
793: return;
794: }
795: }
796:
797: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
798: &s_objet_argument) == d_erreur)
799: {
800: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
801: return;
802: }
803:
804: /*
805: --------------------------------------------------------------------------------
806: Tangente d'un entier ou d'un réel
807: --------------------------------------------------------------------------------
808: */
809:
810: if (((*s_objet_argument).type == INT) ||
811: ((*s_objet_argument).type == REL))
812: {
813: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
814: {
815: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
816: return;
817: }
818:
819: if ((*s_objet_argument).type == INT)
820: {
821: angle = (real8) (*((integer8 *) (*s_objet_argument).objet));
822: }
823: else
824: {
825: angle = (*((real8 *) (*s_objet_argument).objet));
826: }
827:
828: if (test_cfsf(s_etat_processus, 60) == d_faux)
829: {
830: conversion_degres_vers_radians(&angle);
831: }
832:
833: if ((cos(angle) == 0) && (test_cfsf(s_etat_processus, 59) == d_vrai))
834: {
835: liberation(s_etat_processus, s_objet_argument);
836: liberation(s_etat_processus, s_objet_resultat);
837:
838: (*s_etat_processus).exception = d_ep_division_par_zero;
839: return;
840: }
841:
842: (*((real8 *) (*s_objet_resultat).objet)) = tan(angle);
843: }
844:
845: /*
846: --------------------------------------------------------------------------------
847: Tangente d'un complexe
848: --------------------------------------------------------------------------------
849: */
850:
851: else if ((*s_objet_argument).type == CPL)
852: {
853: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
854: {
855: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
856: return;
857: }
858:
859: f77tan_((struct_complexe16 *) (*s_objet_argument).objet,
860: (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
861:
862: if (erreur != 0)
863: {
864: liberation(s_etat_processus, s_objet_argument);
865: liberation(s_etat_processus, s_objet_resultat);
866:
867: (*s_etat_processus).exception = d_ep_division_par_zero;
868: return;
869: }
870: }
871:
872: /*
873: --------------------------------------------------------------------------------
874: Tangente d'un nom
875: --------------------------------------------------------------------------------
876: */
877:
878: else if ((*s_objet_argument).type == NOM)
879: {
880: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
881: {
882: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
883: return;
884: }
885:
886: if (((*s_objet_resultat).objet =
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 = (*s_objet_resultat).objet;
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_superieur;
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: if (((*l_element_courant).suivant =
918: allocation_maillon(s_etat_processus)) == NULL)
919: {
920: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
921: return;
922: }
923:
924: l_element_courant = (*l_element_courant).suivant;
925: (*l_element_courant).donnee = s_objet_argument;
926:
927: if (((*l_element_courant).suivant =
928: allocation_maillon(s_etat_processus)) == NULL)
929: {
930: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
931: return;
932: }
933:
934: l_element_courant = (*l_element_courant).suivant;
935:
936: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
937: == NULL)
938: {
939: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
940: return;
941: }
942:
943: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
944: .nombre_arguments = 1;
945: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
946: .fonction = instruction_tan;
947:
948: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
949: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
950: {
951: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
952: return;
953: }
954:
955: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
956: .nom_fonction, "TAN");
957:
958: if (((*l_element_courant).suivant =
959: allocation_maillon(s_etat_processus)) == NULL)
960: {
961: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
962: return;
963: }
964:
965: l_element_courant = (*l_element_courant).suivant;
966:
967: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
968: == NULL)
969: {
970: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
971: return;
972: }
973:
974: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
975: .nombre_arguments = 0;
976: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
977: .fonction = instruction_vers_niveau_inferieur;
978:
979: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
980: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
981: {
982: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
983: return;
984: }
985:
986: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
987: .nom_fonction, ">>");
988:
989: (*l_element_courant).suivant = NULL;
990: s_objet_argument = NULL;
991: }
992:
993: /*
994: --------------------------------------------------------------------------------
995: Tangente d'une expression
996: --------------------------------------------------------------------------------
997: */
998:
999: else if (((*s_objet_argument).type == ALG) ||
1000: ((*s_objet_argument).type == RPN))
1001: {
1002: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
1003: 'N')) == NULL)
1004: {
1005: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1006: return;
1007: }
1008:
1009: l_element_courant = (struct_liste_chainee *)
1010: (*s_copie_argument).objet;
1011: l_element_precedent = l_element_courant;
1012:
1013: while((*l_element_courant).suivant != NULL)
1014: {
1015: l_element_precedent = l_element_courant;
1016: l_element_courant = (*l_element_courant).suivant;
1017: }
1018:
1019: if (((*l_element_precedent).suivant =
1020: allocation_maillon(s_etat_processus)) == NULL)
1021: {
1022: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1023: return;
1024: }
1025:
1026: if (((*(*l_element_precedent).suivant).donnee =
1027: allocation(s_etat_processus, FCT)) == NULL)
1028: {
1029: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1030: return;
1031: }
1032:
1033: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1034: .donnee).objet)).nombre_arguments = 1;
1035: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1036: .donnee).objet)).fonction = instruction_tan;
1037:
1038: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1039: .suivant).donnee).objet)).nom_fonction =
1040: malloc(4 * sizeof(unsigned char))) == NULL)
1041: {
1042: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1043: return;
1044: }
1045:
1046: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1047: .suivant).donnee).objet)).nom_fonction, "TAN");
1048:
1049: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1050:
1051: s_objet_resultat = s_copie_argument;
1052: }
1053:
1054: /*
1055: --------------------------------------------------------------------------------
1056: Réalisation impossible de la fonction tangente
1057: --------------------------------------------------------------------------------
1058: */
1059:
1060: else
1061: {
1062: liberation(s_etat_processus, s_objet_argument);
1063:
1064: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1065: return;
1066: }
1067:
1068: liberation(s_etat_processus, s_objet_argument);
1069:
1070: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1071: s_objet_resultat) == d_erreur)
1072: {
1073: return;
1074: }
1075:
1076: return;
1077: }
1078:
1079:
1080: /*
1081: ================================================================================
1082: Fonction 'tanh'
1083: ================================================================================
1084: Entrées : pointeur sur une structure struct_processus
1085: --------------------------------------------------------------------------------
1086: Sorties :
1087: --------------------------------------------------------------------------------
1088: Effets de bord : néant
1089: ================================================================================
1090: */
1091:
1092: void
1093: instruction_tanh(struct_processus *s_etat_processus)
1094: {
1095: real8 argument;
1096:
1097: integer4 erreur;
1098:
1099: struct_liste_chainee *l_element_courant;
1100: struct_liste_chainee *l_element_precedent;
1101:
1102: struct_objet *s_copie_argument;
1103: struct_objet *s_objet_argument;
1104: struct_objet *s_objet_resultat;
1105:
1106: (*s_etat_processus).erreur_execution = d_ex;
1107:
1108: if ((*s_etat_processus).affichage_arguments == 'Y')
1109: {
1110: printf("\n TANH ");
1111:
1112: if ((*s_etat_processus).langue == 'F')
1113: {
1114: printf("(tangente hyperbolique)\n\n");
1115: }
1116: else
1117: {
1118: printf("(hyperbolic tangent)\n\n");
1119: }
1120:
1121: printf(" 1: %s, %s\n", d_INT, d_REL);
1122: printf("-> 1: %s\n\n", d_INT);
1123:
1124: printf(" 1: %s\n", d_CPL);
1125: printf("-> 1: %s\n\n", d_CPL);
1126:
1127: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1128: printf("-> 1: %s\n\n", d_ALG);
1129:
1130: printf(" 1: %s\n", d_RPN);
1131: printf("-> 1: %s\n", d_RPN);
1132:
1133: return;
1134: }
1135: else if ((*s_etat_processus).test_instruction == 'Y')
1136: {
1137: (*s_etat_processus).nombre_arguments = 1;
1138: return;
1139: }
1140:
1141: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1142: {
1143: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1144: {
1145: return;
1146: }
1147: }
1148:
1149: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1150: &s_objet_argument) == d_erreur)
1151: {
1152: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1153: return;
1154: }
1155:
1156: /*
1157: --------------------------------------------------------------------------------
1158: Tangente hyperbolique d'un entier ou d'un réel
1159: --------------------------------------------------------------------------------
1160: */
1161:
1162: if (((*s_objet_argument).type == INT) ||
1163: ((*s_objet_argument).type == REL))
1164: {
1165: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1166: {
1167: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1168: return;
1169: }
1170:
1171: if ((*s_objet_argument).type == INT)
1172: {
1173: argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
1174: }
1175: else
1176: {
1177: argument = (*((real8 *) (*s_objet_argument).objet));
1178: }
1179:
1180: (*((real8 *) (*s_objet_resultat).objet)) = tanh(argument);
1181: }
1182:
1183: /*
1184: --------------------------------------------------------------------------------
1185: Tangente hyperbolique d'un complexe
1186: --------------------------------------------------------------------------------
1187: */
1188:
1189: else if ((*s_objet_argument).type == CPL)
1190: {
1191: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
1192: {
1193: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1194: return;
1195: }
1196:
1197: f77tanh_((struct_complexe16 *) (*s_objet_argument).objet,
1198: (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
1199:
1200: if (erreur != 0)
1201: {
1202: liberation(s_etat_processus, s_objet_argument);
1203: liberation(s_etat_processus, s_objet_resultat);
1204:
1205: (*s_etat_processus).exception = d_ep_division_par_zero;
1206: return;
1207: }
1208: }
1209:
1210: /*
1211: --------------------------------------------------------------------------------
1212: Tangente hyperbolique d'un nom
1213: --------------------------------------------------------------------------------
1214: */
1215:
1216: else if ((*s_objet_argument).type == NOM)
1217: {
1218: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1219: {
1220: (*s_etat_processus).erreur_systeme = 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_tanh;
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, "TANH");
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: Tangente hyperbolique 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, s_objet_argument,
1341: '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_tanh;
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, "TANH");
1386:
1387: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1388:
1389: s_objet_resultat = s_copie_argument;
1390: }
1391:
1392: /*
1393: --------------------------------------------------------------------------------
1394: Réalisation impossible de la fonction tangente hyperbolique
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:
1418: /*
1419: ================================================================================
1420: Fonction 'true'
1421: ================================================================================
1422: Entrées : structure processus
1423: --------------------------------------------------------------------------------
1424: Sorties :
1425: --------------------------------------------------------------------------------
1426: Effets de bord : néant
1427: ================================================================================
1428: */
1429:
1430: void
1431: instruction_true(struct_processus *s_etat_processus)
1432: {
1433: struct_objet *s_objet;
1434:
1435: if ((*s_etat_processus).affichage_arguments == 'Y')
1436: {
1437: printf("\n TRUE ");
1438:
1439: if ((*s_etat_processus).langue == 'F')
1440: {
1441: printf("(valeur vraie)\n\n");
1442: }
1443: else
1444: {
1445: printf("(true value)\n\n");
1446: }
1447:
1448: printf("-> 1: %s\n", d_INT);
1449:
1450: return;
1451: }
1452: else if ((*s_etat_processus).test_instruction == 'Y')
1453: {
1454: (*s_etat_processus).nombre_arguments = -1;
1455: return;
1456: }
1457:
1458: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
1459: {
1460: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1461: return;
1462: }
1463:
1464: (*((integer8 *) (*s_objet).objet)) = -1;
1465:
1466: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1467: s_objet) == d_erreur)
1468: {
1469: return;
1470: }
1471:
1472: return;
1473: }
1474:
1475: // vim: ts=4