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