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