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