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