![[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:
1.12 ! bertrand 348: if (((*s_objet).type == INT) || ((*s_objet).type == REL))
1.1 bertrand 349: {
350: if ((*s_objet).type == INT)
351: {
352: condition = ((*((integer8 *) (*s_objet).objet)) == 0)
353: ? d_faux : d_vrai;
354: }
355: else
356: {
357: condition = ((*((real8 *) (*s_objet).objet)) == 0)
358: ? d_faux : d_vrai;
359: }
360:
361: if (condition == d_vrai)
362: {
363:
364: /*
365: * condition == d_vrai : exécution de ce qui se trouve entre
366: * THEN et ELSE ou END.
367: */
368:
1.11 bertrand 369: if (((*(*s_etat_processus).l_base_pile_systeme).clause ==
370: 'I') || ((*(*s_etat_processus).l_base_pile_systeme).clause
1.12 ! bertrand 371: == 'X'))
1.1 bertrand 372: {
373: (*(*s_etat_processus).l_base_pile_systeme).clause = 'T';
374: }
375: else
376: {
1.10 bertrand 377: if ((*s_etat_processus).l_base_pile_systeme == NULL)
378: {
379: (*s_etat_processus).erreur_systeme = d_es_pile_vide;
380: return;
381: }
382:
383: l_element_courant = (*(*s_etat_processus).l_base_pile_systeme)
384: .suivant;
385:
386: while(l_element_courant != NULL)
387: {
388: if ((*l_element_courant).clause == 'K')
389: {
390: (*l_element_courant).clause = 'Q';
391: break;
392: }
393:
394: l_element_courant = (*l_element_courant).suivant;
395: }
1.1 bertrand 396: }
397: }
398: else
399: {
400: /*
401: * condition == d_faux : saut à END ou exécution de ce qui se
402: * trouve entre ELSE et END
403: */
404:
405: if ((*(*s_etat_processus).l_base_pile_systeme).clause != 'T')
406: {
407: /*
408: * Traitement de ELSEIF
409: */
410:
411: if (((*(*s_etat_processus).l_base_pile_systeme).clause !=
412: 'K') && ((*(*s_etat_processus).l_base_pile_systeme)
413: .clause != 'C'))
414: {
415: (*(*s_etat_processus).l_base_pile_systeme).clause = 'E';
416: }
417: }
418:
419: niveau = 0;
420: drapeau_fin = d_faux;
421:
422: if ((*s_etat_processus).mode_execution_programme == 'Y')
423: {
424: tampon = (*s_etat_processus).instruction_courante;
425:
426: do
427: {
428: if (recherche_instruction_suivante(s_etat_processus)
429: == d_erreur)
430: {
431: liberation(s_etat_processus, s_objet);
432:
433: if ((*s_etat_processus).instruction_courante != NULL)
434: {
435: free((*s_etat_processus).instruction_courante);
436: }
437:
438: (*s_etat_processus).instruction_courante = tampon;
439: (*s_etat_processus).erreur_execution =
440: d_ex_erreur_traitement_condition;
441: return;
442: }
443:
444: if ((instruction_majuscule = conversion_majuscule(
445: (*s_etat_processus).instruction_courante)) == NULL)
446: {
447: liberation(s_etat_processus, s_objet);
448:
449: free((*s_etat_processus).instruction_courante);
450: (*s_etat_processus).instruction_courante = tampon;
451: (*s_etat_processus).erreur_systeme =
452: d_es_allocation_memoire;
453: return;
454: }
455:
456: if (niveau == 0)
457: {
458: if (((*(*s_etat_processus).l_base_pile_systeme)
459: .clause != 'K') && ((*(*s_etat_processus)
460: .l_base_pile_systeme) .clause != 'C'))
461: {
462:
463: /*
464: * Traitement de IF/THEN/ELSEIF/THEN/ELSE/END
465: */
466:
467: if ((strcmp(instruction_majuscule, "END") == 0) ||
468: (strcmp(instruction_majuscule, "ELSE")
469: == 0) || (strcmp(instruction_majuscule,
470: "ELSEIF") == 0))
471: {
472: (*s_etat_processus).position_courante
473: -= (strlen(instruction_majuscule) + 1);
474: drapeau_fin = d_vrai;
475: }
476: else
477: {
478: drapeau_fin = d_faux;
479: }
480: }
481: else
482: {
483: /*
484: * Traitement de CASE/THEN/END
485: */
486:
487: if (strcmp(instruction_majuscule, "ELSE") == 0)
488: {
489: liberation(s_etat_processus, s_objet);
490:
491: free((*s_etat_processus).instruction_courante);
492: free(instruction_majuscule);
493:
494: (*s_etat_processus).instruction_courante =
495: tampon;
496: (*s_etat_processus).erreur_execution =
497: d_ex_erreur_traitement_condition;
498: return;
499: }
500: else if (strcmp(instruction_majuscule, "END") == 0)
501: {
1.10 bertrand 502: instruction_end(s_etat_processus);
1.1 bertrand 503: drapeau_fin = d_vrai;
504: }
505: else
506: {
507: drapeau_fin = d_faux;
508: }
509: }
510: }
511: else
512: {
513: drapeau_fin = d_faux;
514: }
515:
516: if ((strcmp(instruction_majuscule, "CASE") == 0) ||
517: (strcmp(instruction_majuscule, "DO") == 0) ||
518: (strcmp(instruction_majuscule, "IF") == 0) ||
519: (strcmp(instruction_majuscule, "IFERR") == 0) ||
520: (strcmp(instruction_majuscule, "SELECT") == 0) ||
521: (strcmp(instruction_majuscule, "WHILE") == 0))
522: {
523: niveau++;
524: }
525: else if (strcmp(instruction_majuscule, "END") == 0)
526: {
527: niveau--;
528: }
529:
530: free(instruction_majuscule);
531: free((*s_etat_processus).instruction_courante);
532: } while(drapeau_fin == d_faux);
533:
534: (*s_etat_processus).instruction_courante = tampon;
535: }
536: else
537: {
538: /*
539: * Vérification du pointeur de prédiction de saut.
540: */
541:
542: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
543: .expression_courante).donnee).mutex)) != 0)
544: {
545: (*s_etat_processus).erreur_systeme = d_es_processus;
546: return;
547: }
548:
549: if ((*((struct_fonction *) (*(*(*s_etat_processus)
550: .expression_courante).donnee).objet)).prediction_saut
551: != NULL)
552: {
553: s_registre = (*s_etat_processus).expression_courante;
554:
555: (*s_etat_processus).expression_courante =
556: (struct_liste_chainee *)
557: (*((struct_fonction *) (*(*(*s_etat_processus)
558: .expression_courante).donnee).objet))
559: .prediction_saut;
560: fonction = (*((struct_fonction *)
561: (*(*(*s_etat_processus).expression_courante)
562: .donnee).objet)).fonction;
563: execution = (*((struct_fonction *)
564: (*(*s_registre).donnee).objet))
565: .prediction_execution;
566:
567: if (pthread_mutex_unlock(&((*(*s_registre).donnee).mutex))
568: != 0)
569: {
570: (*s_etat_processus).erreur_systeme = d_es_processus;
571: return;
572: }
573:
574: if (execution == d_vrai)
575: {
576: fonction(s_etat_processus);
577: }
578: }
579: else
580: {
581: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
582: .expression_courante).donnee).mutex)) != 0)
583: {
584: (*s_etat_processus).erreur_systeme = d_es_processus;
585: return;
586: }
587:
588: s_registre = (*s_etat_processus).expression_courante;
589: execution = d_faux;
590:
591: do
592: {
593: if (((*s_etat_processus).expression_courante =
594: (*(*s_etat_processus).expression_courante)
595: .suivant) == NULL)
596: {
597: liberation(s_etat_processus, s_objet);
598: (*s_etat_processus).erreur_execution =
599: d_ex_erreur_traitement_condition;
600: return;
601: }
602:
603: if ((*(*(*s_etat_processus).expression_courante)
604: .donnee).type == FCT)
605: {
606: fonction = (*((struct_fonction *)
607: (*(*(*s_etat_processus).expression_courante)
608: .donnee).objet)).fonction;
609:
610: if (niveau == 0)
611: {
612: if (((*(*s_etat_processus).l_base_pile_systeme)
613: .clause != 'K') &&
614: ((*(*s_etat_processus)
1.10 bertrand 615: .l_base_pile_systeme).clause != 'C'))
1.1 bertrand 616: {
617: /*
618: * Traitement de IF/THEN/ELSEIF/THEN/
619: * ELSE/END
620: */
621:
622: if ((fonction == instruction_end) ||
623: (fonction == instruction_else) ||
624: (fonction == instruction_elseif))
625: {
626: fonction(s_etat_processus);
627: execution = d_vrai;
628: drapeau_fin = d_vrai;
629: }
630: else
631: {
632: drapeau_fin = d_faux;
633: }
634: }
635: else
636: {
637: /*
638: * Traitement de CASE/THEN/END
639: */
640:
641: if (fonction == instruction_else)
642: {
643: liberation(s_etat_processus, s_objet);
644:
645: if ((drapeau_fin == d_faux) &&
646: ((*s_etat_processus)
647: .expression_courante != NULL))
648: {
649: (*s_etat_processus)
650: .expression_courante
651: = (*(*s_etat_processus)
652: .expression_courante)
653: .suivant;
654: }
655:
656: (*s_etat_processus).erreur_execution =
657: d_ex_erreur_traitement_condition;
658: return;
659: }
660: else if (fonction == instruction_end)
661: {
1.10 bertrand 662: fonction(s_etat_processus);
663: execution = d_vrai;
1.1 bertrand 664: drapeau_fin = d_vrai;
665: }
666: else
667: {
668: drapeau_fin = d_faux;
669: }
670: }
671: }
672: else
673: {
674: drapeau_fin = d_faux;
675: }
676:
677: if ((fonction == instruction_case) ||
678: (fonction == instruction_do) ||
679: (fonction == instruction_if) ||
680: (fonction == instruction_iferr) ||
681: (fonction == instruction_select) ||
682: (fonction == instruction_while))
683: {
684: niveau++;
685: }
686: else if (fonction == instruction_end)
687: {
688: niveau--;
689: }
690: }
691: } while(drapeau_fin == d_faux);
692:
693: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
694: .expression_courante).donnee).mutex)) != 0)
695: {
696: (*s_etat_processus).erreur_systeme = d_es_processus;
697: return;
698: }
699:
700: (*((struct_fonction *) (*(*s_registre).donnee).objet))
701: .prediction_saut = (*s_etat_processus)
702: .expression_courante;
703: (*((struct_fonction *) (*(*s_registre).donnee).objet))
704: .prediction_execution = execution;
705:
706: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
707: .expression_courante).donnee).mutex)) != 0)
708: {
709: (*s_etat_processus).erreur_systeme = d_es_processus;
710: return;
711: }
712: }
713: }
714: }
715: }
716: else
717: {
718: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
719: return;
720: }
721:
722: liberation(s_etat_processus, s_objet);
723: return;
724: }
725:
726:
727: /*
728: ================================================================================
729: Fonction 'tan'
730: ================================================================================
731: Entrées : pointeur sur une structure struct_processus
732: --------------------------------------------------------------------------------
733: Sorties :
734: --------------------------------------------------------------------------------
735: Effets de bord : néant
736: ================================================================================
737: */
738:
739: void
740: instruction_tan(struct_processus *s_etat_processus)
741: {
742: real8 angle;
743:
744: integer4 erreur;
745:
746: struct_liste_chainee *l_element_courant;
747: struct_liste_chainee *l_element_precedent;
748:
749: struct_objet *s_copie_argument;
750: struct_objet *s_objet_argument;
751: struct_objet *s_objet_resultat;
752:
753: (*s_etat_processus).erreur_execution = d_ex;
754:
755: if ((*s_etat_processus).affichage_arguments == 'Y')
756: {
757: printf("\n TAN ");
758:
759: if ((*s_etat_processus).langue == 'F')
760: {
761: printf("(tangente)\n\n");
762: }
763: else
764: {
765: printf("(tangent)\n\n");
766: }
767:
768: printf(" 1: %s, %s\n", d_INT, d_REL);
769: printf("-> 1: %s\n\n", d_REL);
770:
771: printf(" 1: %s\n", d_CPL);
772: printf("-> 1: %s\n\n", d_CPL);
773:
774: printf(" 1: %s, %s\n", d_NOM, d_ALG);
775: printf("-> 1: %s\n\n", d_ALG);
776:
777: printf(" 1: %s\n", d_RPN);
778: printf("-> 1: %s\n", d_RPN);
779:
780: return;
781: }
782: else if ((*s_etat_processus).test_instruction == 'Y')
783: {
784: (*s_etat_processus).nombre_arguments = 1;
785: return;
786: }
787:
788: if (test_cfsf(s_etat_processus, 31) == d_vrai)
789: {
790: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
791: {
792: return;
793: }
794: }
795:
796: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
797: &s_objet_argument) == d_erreur)
798: {
799: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
800: return;
801: }
802:
803: /*
804: --------------------------------------------------------------------------------
805: Tangente d'un entier ou d'un réel
806: --------------------------------------------------------------------------------
807: */
808:
809: if (((*s_objet_argument).type == INT) ||
810: ((*s_objet_argument).type == REL))
811: {
812: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
813: {
814: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
815: return;
816: }
817:
818: if ((*s_objet_argument).type == INT)
819: {
820: angle = (real8) (*((integer8 *) (*s_objet_argument).objet));
821: }
822: else
823: {
824: angle = (*((real8 *) (*s_objet_argument).objet));
825: }
826:
827: if (test_cfsf(s_etat_processus, 60) == d_faux)
828: {
829: conversion_degres_vers_radians(&angle);
830: }
831:
832: if ((cos(angle) == 0) && (test_cfsf(s_etat_processus, 59) == d_vrai))
833: {
834: liberation(s_etat_processus, s_objet_argument);
835: liberation(s_etat_processus, s_objet_resultat);
836:
837: (*s_etat_processus).exception = d_ep_division_par_zero;
838: return;
839: }
840:
841: (*((real8 *) (*s_objet_resultat).objet)) = tan(angle);
842: }
843:
844: /*
845: --------------------------------------------------------------------------------
846: Tangente d'un complexe
847: --------------------------------------------------------------------------------
848: */
849:
850: else if ((*s_objet_argument).type == CPL)
851: {
852: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
853: {
854: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
855: return;
856: }
857:
858: f77tan_((struct_complexe16 *) (*s_objet_argument).objet,
859: (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
860:
861: if (erreur != 0)
862: {
863: liberation(s_etat_processus, s_objet_argument);
864: liberation(s_etat_processus, s_objet_resultat);
865:
866: (*s_etat_processus).exception = d_ep_division_par_zero;
867: return;
868: }
869: }
870:
871: /*
872: --------------------------------------------------------------------------------
873: Tangente d'un nom
874: --------------------------------------------------------------------------------
875: */
876:
877: else if ((*s_objet_argument).type == NOM)
878: {
879: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
880: {
881: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
882: return;
883: }
884:
885: if (((*s_objet_resultat).objet =
886: allocation_maillon(s_etat_processus)) == NULL)
887: {
888: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
889: return;
890: }
891:
892: l_element_courant = (*s_objet_resultat).objet;
893:
894: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
895: == NULL)
896: {
897: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
898: return;
899: }
900:
901: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
902: .nombre_arguments = 0;
903: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
904: .fonction = instruction_vers_niveau_superieur;
905:
906: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
907: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
908: {
909: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
910: return;
911: }
912:
913: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
914: .nom_fonction, "<<");
915:
916: if (((*l_element_courant).suivant =
917: allocation_maillon(s_etat_processus)) == NULL)
918: {
919: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
920: return;
921: }
922:
923: l_element_courant = (*l_element_courant).suivant;
924: (*l_element_courant).donnee = s_objet_argument;
925:
926: if (((*l_element_courant).suivant =
927: allocation_maillon(s_etat_processus)) == NULL)
928: {
929: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
930: return;
931: }
932:
933: l_element_courant = (*l_element_courant).suivant;
934:
935: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
936: == NULL)
937: {
938: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
939: return;
940: }
941:
942: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
943: .nombre_arguments = 1;
944: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
945: .fonction = instruction_tan;
946:
947: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
948: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
949: {
950: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
951: return;
952: }
953:
954: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
955: .nom_fonction, "TAN");
956:
957: if (((*l_element_courant).suivant =
958: allocation_maillon(s_etat_processus)) == NULL)
959: {
960: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
961: return;
962: }
963:
964: l_element_courant = (*l_element_courant).suivant;
965:
966: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
967: == NULL)
968: {
969: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
970: return;
971: }
972:
973: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
974: .nombre_arguments = 0;
975: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
976: .fonction = instruction_vers_niveau_inferieur;
977:
978: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
979: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
980: {
981: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
982: return;
983: }
984:
985: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
986: .nom_fonction, ">>");
987:
988: (*l_element_courant).suivant = NULL;
989: s_objet_argument = NULL;
990: }
991:
992: /*
993: --------------------------------------------------------------------------------
994: Tangente d'une expression
995: --------------------------------------------------------------------------------
996: */
997:
998: else if (((*s_objet_argument).type == ALG) ||
999: ((*s_objet_argument).type == RPN))
1000: {
1001: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
1002: 'N')) == NULL)
1003: {
1004: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1005: return;
1006: }
1007:
1008: l_element_courant = (struct_liste_chainee *)
1009: (*s_copie_argument).objet;
1010: l_element_precedent = l_element_courant;
1011:
1012: while((*l_element_courant).suivant != NULL)
1013: {
1014: l_element_precedent = l_element_courant;
1015: l_element_courant = (*l_element_courant).suivant;
1016: }
1017:
1018: if (((*l_element_precedent).suivant =
1019: allocation_maillon(s_etat_processus)) == NULL)
1020: {
1021: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1022: return;
1023: }
1024:
1025: if (((*(*l_element_precedent).suivant).donnee =
1026: allocation(s_etat_processus, FCT)) == NULL)
1027: {
1028: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1029: return;
1030: }
1031:
1032: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1033: .donnee).objet)).nombre_arguments = 1;
1034: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1035: .donnee).objet)).fonction = instruction_tan;
1036:
1037: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1038: .suivant).donnee).objet)).nom_fonction =
1039: malloc(4 * sizeof(unsigned char))) == NULL)
1040: {
1041: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1042: return;
1043: }
1044:
1045: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1046: .suivant).donnee).objet)).nom_fonction, "TAN");
1047:
1048: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1049:
1050: s_objet_resultat = s_copie_argument;
1051: }
1052:
1053: /*
1054: --------------------------------------------------------------------------------
1055: Réalisation impossible de la fonction tangente
1056: --------------------------------------------------------------------------------
1057: */
1058:
1059: else
1060: {
1061: liberation(s_etat_processus, s_objet_argument);
1062:
1063: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1064: return;
1065: }
1066:
1067: liberation(s_etat_processus, s_objet_argument);
1068:
1069: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1070: s_objet_resultat) == d_erreur)
1071: {
1072: return;
1073: }
1074:
1075: return;
1076: }
1077:
1078:
1079: /*
1080: ================================================================================
1081: Fonction 'tanh'
1082: ================================================================================
1083: Entrées : pointeur sur une structure struct_processus
1084: --------------------------------------------------------------------------------
1085: Sorties :
1086: --------------------------------------------------------------------------------
1087: Effets de bord : néant
1088: ================================================================================
1089: */
1090:
1091: void
1092: instruction_tanh(struct_processus *s_etat_processus)
1093: {
1094: real8 argument;
1095:
1096: integer4 erreur;
1097:
1098: struct_liste_chainee *l_element_courant;
1099: struct_liste_chainee *l_element_precedent;
1100:
1101: struct_objet *s_copie_argument;
1102: struct_objet *s_objet_argument;
1103: struct_objet *s_objet_resultat;
1104:
1105: (*s_etat_processus).erreur_execution = d_ex;
1106:
1107: if ((*s_etat_processus).affichage_arguments == 'Y')
1108: {
1109: printf("\n TANH ");
1110:
1111: if ((*s_etat_processus).langue == 'F')
1112: {
1113: printf("(tangente hyperbolique)\n\n");
1114: }
1115: else
1116: {
1117: printf("(hyperbolic tangent)\n\n");
1118: }
1119:
1120: printf(" 1: %s, %s\n", d_INT, d_REL);
1121: printf("-> 1: %s\n\n", d_INT);
1122:
1123: printf(" 1: %s\n", d_CPL);
1124: printf("-> 1: %s\n\n", d_CPL);
1125:
1126: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1127: printf("-> 1: %s\n\n", d_ALG);
1128:
1129: printf(" 1: %s\n", d_RPN);
1130: printf("-> 1: %s\n", d_RPN);
1131:
1132: return;
1133: }
1134: else if ((*s_etat_processus).test_instruction == 'Y')
1135: {
1136: (*s_etat_processus).nombre_arguments = 1;
1137: return;
1138: }
1139:
1140: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1141: {
1142: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1143: {
1144: return;
1145: }
1146: }
1147:
1148: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1149: &s_objet_argument) == d_erreur)
1150: {
1151: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1152: return;
1153: }
1154:
1155: /*
1156: --------------------------------------------------------------------------------
1157: Tangente hyperbolique d'un entier ou d'un réel
1158: --------------------------------------------------------------------------------
1159: */
1160:
1161: if (((*s_objet_argument).type == INT) ||
1162: ((*s_objet_argument).type == REL))
1163: {
1164: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1165: {
1166: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1167: return;
1168: }
1169:
1170: if ((*s_objet_argument).type == INT)
1171: {
1172: argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
1173: }
1174: else
1175: {
1176: argument = (*((real8 *) (*s_objet_argument).objet));
1177: }
1178:
1179: (*((real8 *) (*s_objet_resultat).objet)) = tanh(argument);
1180: }
1181:
1182: /*
1183: --------------------------------------------------------------------------------
1184: Tangente hyperbolique d'un complexe
1185: --------------------------------------------------------------------------------
1186: */
1187:
1188: else if ((*s_objet_argument).type == CPL)
1189: {
1190: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
1191: {
1192: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1193: return;
1194: }
1195:
1196: f77tanh_((struct_complexe16 *) (*s_objet_argument).objet,
1197: (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
1198:
1199: if (erreur != 0)
1200: {
1201: liberation(s_etat_processus, s_objet_argument);
1202: liberation(s_etat_processus, s_objet_resultat);
1203:
1204: (*s_etat_processus).exception = d_ep_division_par_zero;
1205: return;
1206: }
1207: }
1208:
1209: /*
1210: --------------------------------------------------------------------------------
1211: Tangente hyperbolique d'un nom
1212: --------------------------------------------------------------------------------
1213: */
1214:
1215: else if ((*s_objet_argument).type == NOM)
1216: {
1217: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1218: {
1219: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1220: return;
1221: }
1222:
1223: if (((*s_objet_resultat).objet =
1224: allocation_maillon(s_etat_processus)) == NULL)
1225: {
1226: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1227: return;
1228: }
1229:
1230: l_element_courant = (*s_objet_resultat).objet;
1231:
1232: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1233: == NULL)
1234: {
1235: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1236: return;
1237: }
1238:
1239: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1240: .nombre_arguments = 0;
1241: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1242: .fonction = instruction_vers_niveau_superieur;
1243:
1244: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1245: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1246: {
1247: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1248: return;
1249: }
1250:
1251: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1252: .nom_fonction, "<<");
1253:
1254: if (((*l_element_courant).suivant =
1255: allocation_maillon(s_etat_processus)) == NULL)
1256: {
1257: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1258: return;
1259: }
1260:
1261: l_element_courant = (*l_element_courant).suivant;
1262: (*l_element_courant).donnee = s_objet_argument;
1263:
1264: if (((*l_element_courant).suivant =
1265: allocation_maillon(s_etat_processus)) == NULL)
1266: {
1267: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1268: return;
1269: }
1270:
1271: l_element_courant = (*l_element_courant).suivant;
1272:
1273: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1274: == NULL)
1275: {
1276: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1277: return;
1278: }
1279:
1280: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1281: .nombre_arguments = 1;
1282: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1283: .fonction = instruction_tanh;
1284:
1285: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1286: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
1287: {
1288: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1289: return;
1290: }
1291:
1292: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1293: .nom_fonction, "TANH");
1294:
1295: if (((*l_element_courant).suivant =
1296: allocation_maillon(s_etat_processus)) == NULL)
1297: {
1298: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1299: return;
1300: }
1301:
1302: l_element_courant = (*l_element_courant).suivant;
1303:
1304: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1305: == NULL)
1306: {
1307: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1308: return;
1309: }
1310:
1311: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1312: .nombre_arguments = 0;
1313: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1314: .fonction = instruction_vers_niveau_inferieur;
1315:
1316: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1317: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1318: {
1319: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1320: return;
1321: }
1322:
1323: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1324: .nom_fonction, ">>");
1325:
1326: (*l_element_courant).suivant = NULL;
1327: s_objet_argument = NULL;
1328: }
1329:
1330: /*
1331: --------------------------------------------------------------------------------
1332: Tangente hyperbolique d'une expression
1333: --------------------------------------------------------------------------------
1334: */
1335:
1336: else if (((*s_objet_argument).type == ALG) ||
1337: ((*s_objet_argument).type == RPN))
1338: {
1339: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
1340: 'N')) == NULL)
1341: {
1342: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1343: return;
1344: }
1345:
1346: l_element_courant = (struct_liste_chainee *)
1347: (*s_copie_argument).objet;
1348: l_element_precedent = l_element_courant;
1349:
1350: while((*l_element_courant).suivant != NULL)
1351: {
1352: l_element_precedent = l_element_courant;
1353: l_element_courant = (*l_element_courant).suivant;
1354: }
1355:
1356: if (((*l_element_precedent).suivant =
1357: allocation_maillon(s_etat_processus)) == NULL)
1358: {
1359: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1360: return;
1361: }
1362:
1363: if (((*(*l_element_precedent).suivant).donnee =
1364: allocation(s_etat_processus, FCT)) == NULL)
1365: {
1366: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1367: return;
1368: }
1369:
1370: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1371: .donnee).objet)).nombre_arguments = 1;
1372: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1373: .donnee).objet)).fonction = instruction_tanh;
1374:
1375: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1376: .suivant).donnee).objet)).nom_fonction =
1377: malloc(5 * sizeof(unsigned char))) == NULL)
1378: {
1379: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1380: return;
1381: }
1382:
1383: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1384: .suivant).donnee).objet)).nom_fonction, "TANH");
1385:
1386: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1387:
1388: s_objet_resultat = s_copie_argument;
1389: }
1390:
1391: /*
1392: --------------------------------------------------------------------------------
1393: Réalisation impossible de la fonction tangente hyperbolique
1394: --------------------------------------------------------------------------------
1395: */
1396:
1397: else
1398: {
1399: liberation(s_etat_processus, s_objet_argument);
1400:
1401: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1402: return;
1403: }
1404:
1405: liberation(s_etat_processus, s_objet_argument);
1406:
1407: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1408: s_objet_resultat) == d_erreur)
1409: {
1410: return;
1411: }
1412:
1413: return;
1414: }
1415:
1416:
1417: /*
1418: ================================================================================
1419: Fonction 'true'
1420: ================================================================================
1421: Entrées : structure processus
1422: --------------------------------------------------------------------------------
1423: Sorties :
1424: --------------------------------------------------------------------------------
1425: Effets de bord : néant
1426: ================================================================================
1427: */
1428:
1429: void
1430: instruction_true(struct_processus *s_etat_processus)
1431: {
1432: struct_objet *s_objet;
1433:
1434: if ((*s_etat_processus).affichage_arguments == 'Y')
1435: {
1436: printf("\n TRUE ");
1437:
1438: if ((*s_etat_processus).langue == 'F')
1439: {
1440: printf("(valeur vraie)\n\n");
1441: }
1442: else
1443: {
1444: printf("(true value)\n\n");
1445: }
1446:
1447: printf("-> 1: %s\n", d_INT);
1448:
1449: return;
1450: }
1451: else if ((*s_etat_processus).test_instruction == 'Y')
1452: {
1453: (*s_etat_processus).nombre_arguments = -1;
1454: return;
1455: }
1456:
1457: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
1458: {
1459: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1460: return;
1461: }
1462:
1463: (*((integer8 *) (*s_objet).objet)) = -1;
1464:
1465: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1466: s_objet) == d_erreur)
1467: {
1468: return;
1469: }
1470:
1471: return;
1472: }
1473:
1474: // vim: ts=4