Annotation of rpl/src/instructions_f1.c, revision 1.86
1.1 bertrand 1: /*
2: ================================================================================
1.86 ! bertrand 3: RPL/2 (R) version 4.1.33
! 4: Copyright (C) 1989-2021 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 '->'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_fleche(struct_processus *s_etat_processus)
40: {
41: struct_liste_chainee *l_element_courant;
42: struct_liste_chainee *l_emplacement_valeurs;
43:
44: struct_objet *s_objet;
45: struct_objet *s_objet_elementaire;
46: struct_objet *s_expression_algebrique;
47:
48: struct_variable s_variable;
49:
50: struct_variable_partagee s_variable_partagee;
51: struct_variable_statique s_variable_statique;
52:
53: logical1 fin_scrutation;
54: logical1 presence_expression_algebrique;
55:
1.56 bertrand 56: pthread_mutexattr_t attributs_mutex;
57:
1.1 bertrand 58: union_position_variable position_variable;
59:
60: unsigned char instruction_valide;
61: unsigned char *tampon;
62: unsigned char test_instruction;
63:
1.53 bertrand 64: integer8 i;
65: integer8 nombre_variables;
1.1 bertrand 66:
67: void (*fonction)();
68:
69: (*s_etat_processus).erreur_execution = d_ex;
70:
71: if ((*s_etat_processus).affichage_arguments == 'Y')
72: {
73: printf("\n -> ");
74:
75: if ((*s_etat_processus).langue == 'F')
76: {
77: printf("(création de variables locales)\n\n");
78: }
79: else
80: {
81: printf("(create local variables)\n\n");
82: }
83:
84: printf(" n: %s, %s, %s, %s, %s, %s,\n"
85: " %s, %s, %s, %s, %s,\n"
86: " %s, %s, %s, %s, %s,\n"
87: " %s, %s, %s, %s,\n"
1.80 bertrand 88: " %s, %s, %s\n",
1.1 bertrand 89: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
90: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
1.80 bertrand 91: d_SQL, d_SLB, d_PRC, d_MTX, d_REC);
1.1 bertrand 92: printf(" ...\n");
93: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
94: " %s, %s, %s, %s, %s,\n"
95: " %s, %s, %s, %s, %s,\n"
96: " %s, %s, %s, %s,\n"
1.80 bertrand 97: " %s, %s, %s\n",
1.1 bertrand 98: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
99: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
1.80 bertrand 100: d_SQL, d_SLB, d_PRC, d_MTX, d_REC);
1.1 bertrand 101:
102: if ((*s_etat_processus).langue == 'F')
103: {
104: printf(" Utilisation :\n\n");
105: }
106: else
107: {
108: printf(" Usage:\n\n");
109: }
110:
111: printf(" -> (variables) %s\n\n", d_RPN);
112:
1.70 bertrand 113: printf(" -> (variables) %s\n\n", d_ALG);
114:
115: printf(" -> (variables) %s\n", d_NOM);
1.1 bertrand 116:
117: return;
118: }
119: else if ((*s_etat_processus).test_instruction == 'Y')
120: {
121: (*s_etat_processus).nombre_arguments = -1;
122: return;
123: }
124:
125: if (test_cfsf(s_etat_processus, 31) == d_vrai)
126: {
127: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
128: {
129: return;
130: }
131: }
132:
133: (*s_etat_processus).autorisation_empilement_programme = 'N';
134:
135: /*
136: --------------------------------------------------------------------------------
137: Boucler jusqu'au prochain '<<' ou jusqu'à la prochaine expression algébrique
138: --------------------------------------------------------------------------------
139: */
140:
141: test_instruction = (*s_etat_processus).test_instruction;
142: instruction_valide = (*s_etat_processus).instruction_valide;
143: presence_expression_algebrique = d_faux;
144:
145: if ((*s_etat_processus).debug == d_vrai)
146: if (((*s_etat_processus).type_debug &
147: d_debug_variables) != 0)
148: {
149: if ((*s_etat_processus).langue == 'F')
150: {
151: printf("[%d] Recherche des variables locales\n", (int) getpid());
152: }
153: else
154: {
155: printf("[%d] Searching for local variables\n", (int) getpid());
156: }
157:
158: fflush(stdout);
159: }
160:
161: nombre_variables = 0;
162:
163: if ((*s_etat_processus).mode_execution_programme == 'Y')
164: {
165: /*
166: * Le programme est exécuté normalement.
167: */
168:
169: tampon = (*s_etat_processus).instruction_courante;
170:
171: do
172: {
173: if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
174: {
175: (*s_etat_processus).instruction_courante = tampon;
176: return;
177: }
178:
179: if (strcmp((*s_etat_processus).instruction_courante, "<<") == 0)
180: {
181: fin_scrutation = d_vrai;
182: (*s_etat_processus).test_instruction = 'N';
183: }
184: else
185: {
186: fin_scrutation = d_faux;
187: (*s_etat_processus).test_instruction = 'Y';
188: }
189:
190: analyse(s_etat_processus, NULL);
191:
192: if ((*s_etat_processus).instruction_valide == 'N')
193: {
1.65 bertrand 194: (*s_etat_processus).type_en_cours = NON;
1.1 bertrand 195: recherche_type(s_etat_processus);
196:
197: if ((*s_etat_processus).erreur_execution != d_ex)
198: {
199: (*s_etat_processus).instruction_courante = tampon;
200: return;
201: }
202:
203: if ((*(*(*s_etat_processus).l_base_pile).donnee).type == ALG)
204: {
205: (*s_etat_processus).niveau_courant++;
206: fin_scrutation = d_vrai;
207: presence_expression_algebrique = d_vrai;
208:
209: if (depilement(s_etat_processus, &((*s_etat_processus)
210: .l_base_pile), &s_expression_algebrique)
211: == d_erreur)
212: {
213: (*s_etat_processus).erreur_execution =
214: d_ex_manque_argument;
215: (*s_etat_processus).instruction_courante = tampon;
216: return;
217: }
218: }
219: else if ((*(*(*s_etat_processus).l_base_pile).donnee)
220: .type != NOM)
221: {
222: (*s_etat_processus).erreur_execution = d_ex_nom_invalide;
223: (*s_etat_processus).instruction_courante = tampon;
224: return;
225: }
226: else if ((*((struct_nom *) (*(*(*s_etat_processus).l_base_pile)
227: .donnee).objet)).symbole == d_vrai)
228: {
1.68 bertrand 229: (*s_etat_processus).niveau_courant++;
230: fin_scrutation = d_vrai;
231: presence_expression_algebrique = d_vrai;
232:
233: if (depilement(s_etat_processus, &((*s_etat_processus)
234: .l_base_pile), &s_expression_algebrique)
235: == d_erreur)
236: {
237: (*s_etat_processus).erreur_execution =
238: d_ex_manque_argument;
239: (*s_etat_processus).instruction_courante = tampon;
240: return;
241: }
1.1 bertrand 242: }
243: else
244: {
245: nombre_variables = nombre_variables + 1;
246: }
247: }
248: else
249: {
250: if (fin_scrutation == d_faux)
251: {
252: (*s_etat_processus).erreur_execution = d_ex_nom_reserve;
253: (*s_etat_processus).instruction_courante = tampon;
254: return;
255: }
256: }
257:
258: free((*s_etat_processus).instruction_courante);
259: } while(fin_scrutation == d_faux);
260:
261: (*s_etat_processus).instruction_courante = tampon;
262: }
263: else
264: {
265: /*
266: * Une expression est en cours d'évaluation.
267: */
268:
269: l_element_courant = (*(*s_etat_processus).expression_courante).suivant;
270: tampon = (*s_etat_processus).instruction_courante;
271:
272: do
273: {
274: if ((*(*l_element_courant).donnee).type == FCT)
275: {
276: fonction = (*((struct_fonction *) (*(*l_element_courant)
277: .donnee).objet)).fonction;
278:
279: if (fonction == instruction_vers_niveau_superieur)
280: {
281: fin_scrutation = d_vrai;
282: (*s_etat_processus).test_instruction = 'N';
283:
284: analyse(s_etat_processus,
285: instruction_vers_niveau_superieur);
286: }
287: else
288: {
1.9 bertrand 289: (*s_etat_processus).expression_courante = l_element_courant;
1.1 bertrand 290: (*s_etat_processus).erreur_execution = d_ex_nom_invalide;
291: return;
292: }
293: }
294: else if ((*(*l_element_courant).donnee).type == ALG)
295: {
296: (*s_etat_processus).niveau_courant++;
297: fin_scrutation = d_vrai;
298: presence_expression_algebrique = d_vrai;
299:
300: s_expression_algebrique = (*l_element_courant).donnee;
301: }
302: else if ((*(*l_element_courant).donnee).type != NOM)
303: {
1.9 bertrand 304: (*s_etat_processus).expression_courante = l_element_courant;
1.1 bertrand 305: (*s_etat_processus).erreur_execution = d_ex_nom_invalide;
306: return;
307: }
1.68 bertrand 308: else if ((*((struct_nom *) (*(*l_element_courant).donnee).objet))
309: .symbole == d_vrai)
310: {
311: (*s_etat_processus).niveau_courant++;
312: fin_scrutation = d_vrai;
313: presence_expression_algebrique = d_vrai;
314:
315: s_expression_algebrique = (*l_element_courant).donnee;
316: }
1.1 bertrand 317: else
318: {
319: if ((s_objet_elementaire = copie_objet(s_etat_processus,
320: (*l_element_courant).donnee, 'P')) == NULL)
321: {
1.9 bertrand 322: (*s_etat_processus).expression_courante = l_element_courant;
1.1 bertrand 323: (*s_etat_processus).erreur_systeme =
324: d_es_allocation_memoire;
325: return;
326: }
327:
328: if (empilement(s_etat_processus, &((*s_etat_processus)
329: .l_base_pile), s_objet_elementaire) == d_erreur)
330: {
1.9 bertrand 331: (*s_etat_processus).expression_courante = l_element_courant;
1.1 bertrand 332: return;
333: }
334:
335: nombre_variables = nombre_variables + 1;
336: fin_scrutation = d_faux;
337: }
338:
339: (*s_etat_processus).expression_courante = l_element_courant;
340: l_element_courant = (*l_element_courant).suivant;
341: } while((fin_scrutation == d_faux) && (l_element_courant != NULL));
342:
1.9 bertrand 343: (*s_etat_processus).objet_courant =
344: (*(*s_etat_processus).expression_courante).donnee;
1.1 bertrand 345: (*s_etat_processus).instruction_courante = tampon;
346:
347: if (fin_scrutation == d_faux)
348: {
349: (*s_etat_processus).erreur_execution = d_ex_erreur_evaluation;
350: return;
351: }
352: }
353:
354: if (nombre_variables < 1)
355: {
356: (*s_etat_processus).erreur_execution = d_ex_absence_variable;
357: return;
358: }
359:
360: if ((*s_etat_processus).debug == d_vrai)
361: if (((*s_etat_processus).type_debug &
362: d_debug_variables) != 0)
363: {
364: if ((*s_etat_processus).langue == 'F')
365: {
1.55 bertrand 366: printf("[%d] Nombre de variables de niveau %lld : %lld\n",
1.1 bertrand 367: (int) getpid(),
368: (*s_etat_processus).niveau_courant, nombre_variables);
369: }
370: else
371: {
1.55 bertrand 372: printf("[%d] Number of level %lld variables : %lld\n",
1.1 bertrand 373: (int) getpid(),
374: (*s_etat_processus).niveau_courant, nombre_variables);
375: }
376:
377: fflush(stdout);
378: }
379:
380: l_emplacement_valeurs = (*s_etat_processus).l_base_pile;
381:
382: for(i = 0; i < nombre_variables; i++)
383: {
1.11 bertrand 384: if (l_emplacement_valeurs == NULL)
385: {
386: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
387: return;
388: }
389:
1.1 bertrand 390: l_emplacement_valeurs = (*l_emplacement_valeurs).suivant;
391: }
392:
393: l_element_courant = l_emplacement_valeurs;
394:
395: for(i = 0; i < nombre_variables; i++)
396: {
397: if (l_element_courant == NULL)
398: {
399: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
400: return;
401: }
402:
403: l_element_courant = (*l_element_courant).suivant;
404: }
405:
406: for(i = 0; i < nombre_variables; i++)
407: {
408: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
409: &s_objet) == d_erreur)
410: {
411: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
412: return;
413: }
414:
415: if ((s_variable.nom = malloc((strlen(
416: (*((struct_nom *) (*s_objet).objet)).nom) + 1) *
417: sizeof(unsigned char))) == NULL)
418: {
419: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
420: return;
421: }
422:
423: strcpy(s_variable.nom, (*((struct_nom *) (*s_objet).objet)).nom);
424:
425: if ((*s_etat_processus).debug == d_vrai)
426: if (((*s_etat_processus).type_debug &
427: d_debug_variables) != 0)
428: {
429: printf("[%d] Variable %s\n", (int) getpid(), s_variable.nom);
430: fflush(stdout);
431: }
432:
433: s_variable.niveau = (*s_etat_processus).niveau_courant;
434:
435: // Si le drapeau creation_variables_statiques est positionné,
436: // on recherche une entrée dans la table des variables statiques.
437: // Si cette entrée existe, on affecte à la variable créée l'objet
438: // contenu dans la table des variables statiques. Dans le cas contraire,
439: // on crée une entrée dans la table des variables statiques avec
440: // ce qui se trouve dans la pile.
441:
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: /*
449: * Vérification de l'unicité de la variable pour un niveau donné
450: */
451:
452: if (recherche_variable(s_etat_processus, s_variable.nom) == d_vrai)
453: {
454: if ((*s_etat_processus).niveau_courant ==
1.23 bertrand 455: (*(*s_etat_processus).pointeur_variable_courante).niveau)
1.1 bertrand 456: {
457: liberation(s_etat_processus, s_objet);
458: free(s_variable.nom);
459:
460: (*s_etat_processus).erreur_execution = d_ex_creation_variable;
461: return;
462: }
463: }
464:
465: (*s_etat_processus).erreur_systeme = d_es;
466:
467: if ((*(*s_etat_processus).l_base_pile_systeme)
468: .creation_variables_statiques == d_vrai)
469: {
470: if ((*s_etat_processus).mode_execution_programme == 'Y')
471: {
472: position_variable.adresse =
473: (*s_etat_processus).position_courante;
474: }
475: else
476: {
477: position_variable.pointeur =
478: (*s_etat_processus).objet_courant;
479: }
480:
481: if (recherche_variable_statique(s_etat_processus, s_variable.nom,
482: position_variable,
483: ((*s_etat_processus).mode_execution_programme == 'Y')
1.43 bertrand 484: ? 'P' : 'E') != NULL)
1.1 bertrand 485: {
486: // Variable statique à utiliser
487:
488: if ((*s_etat_processus).mode_execution_programme == 'Y')
489: {
490: s_variable.origine = 'P';
491: }
492: else
493: {
494: s_variable.origine = 'E';
495: }
496:
1.43 bertrand 497: s_variable.objet = (*(*s_etat_processus)
498: .pointeur_variable_statique_courante).objet;
499: (*(*s_etat_processus).pointeur_variable_statique_courante)
500: .objet = NULL;
1.1 bertrand 501: }
502: else
503: {
504: // Variable statique à créer
505:
506: s_variable_statique.objet = NULL;
507: (*s_etat_processus).erreur_systeme = d_es;
508:
509: if ((s_variable_statique.nom = malloc((strlen(s_variable.nom)
510: + 1) * sizeof(unsigned char))) == NULL)
511: {
512: (*s_etat_processus).erreur_systeme =
513: d_es_allocation_memoire;
514: return;
515: }
516:
517: strcpy(s_variable_statique.nom, s_variable.nom);
518:
519: if ((*s_etat_processus).mode_execution_programme == 'Y')
520: {
521: s_variable_statique.origine = 'P';
522: s_variable_statique.niveau = 0;
523: s_variable_statique.variable_statique.adresse =
524: (*s_etat_processus).position_courante;
525: }
526: else
527: {
528: s_variable_statique.origine = 'E';
529:
530: /*
531: * Si la variable est appelée depuis une expression
532: * compilée (variable de niveau 0), la variable statique
533: * est persistante (niveau 0). Dans le cas contraire, elle
534: * est persistante à l'expression (niveau courant).
535: */
536:
537: if ((*s_etat_processus).evaluation_expression_compilee
538: == 'Y')
539: {
540: s_variable_statique.niveau = 0;
541: }
542: else
543: {
544: s_variable_statique.niveau =
545: (*s_etat_processus).niveau_courant;
546: }
547:
548: s_variable_statique.variable_statique.pointeur =
549: (*s_etat_processus).objet_courant;
550: }
551:
552: if (creation_variable_statique(s_etat_processus,
553: &s_variable_statique) == d_erreur)
554: {
555: return;
556: }
557:
558: s_variable.objet = (*l_emplacement_valeurs).donnee;
559: (*l_emplacement_valeurs).donnee = NULL;
560: }
561: }
562: else if ((*(*s_etat_processus).l_base_pile_systeme)
563: .creation_variables_partagees == d_vrai)
564: {
565: if ((*s_etat_processus).mode_execution_programme == 'Y')
566: {
567: position_variable.adresse =
568: (*s_etat_processus).position_courante;
569: }
570: else
571: {
572: position_variable.pointeur =
573: (*s_etat_processus).objet_courant;
574: }
575:
1.48 bertrand 576: if (pthread_mutex_lock(&mutex_creation_variable_partagee) != 0)
577: {
578: (*s_etat_processus).erreur_systeme = d_es_processus;
579: return;
580: }
581:
1.1 bertrand 582: if (recherche_variable_partagee(s_etat_processus, s_variable.nom,
583: position_variable,
584: ((*s_etat_processus).mode_execution_programme == 'Y')
1.47 bertrand 585: ? 'P' : 'E') != NULL)
1.1 bertrand 586: {
587: // Variable partagée à utiliser
588:
1.48 bertrand 589: if (pthread_mutex_unlock(&mutex_creation_variable_partagee)
590: != 0)
591: {
592: (*s_etat_processus).erreur_systeme = d_es_processus;
593: return;
594: }
595:
1.1 bertrand 596: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.46 bertrand 597: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 598: {
599: (*s_etat_processus).erreur_systeme = d_es_processus;
600: return;
601: }
602:
603: // Les champs niveau, variable_statique, variable_partagee
604: // et variable_verrouillee sont renseignés lors de l'appel
605: // à la fonction creation_variable().
606:
607: if ((*s_etat_processus).mode_execution_programme == 'Y')
608: {
609: s_variable.origine = 'P';
610: }
611: else
612: {
613: s_variable.origine = 'E';
614: }
615:
616: s_variable.objet = NULL;
617: }
618: else
619: {
1.56 bertrand 620: // Variable partagée à créer
1.1 bertrand 621:
622: (*s_etat_processus).erreur_systeme = d_es;
623:
624: if ((s_variable_partagee.nom = malloc((strlen(s_variable.nom)
625: + 1) * sizeof(unsigned char))) == NULL)
626: {
627: (*s_etat_processus).erreur_systeme =
628: d_es_allocation_memoire;
629: return;
630: }
631:
632: strcpy(s_variable_partagee.nom, s_variable.nom);
633:
634: if ((*s_etat_processus).mode_execution_programme == 'Y')
635: {
636: s_variable_partagee.origine = 'P';
637: s_variable_partagee.niveau = 0;
638: s_variable_partagee.variable_partagee.adresse =
639: (*s_etat_processus).position_courante;
640: }
641: else
642: {
643: s_variable_partagee.origine = 'E';
644:
645: /*
646: * Si la variable est appelée depuis une expression
647: * compilée (variable de niveau 0), la variable statique
648: * est persistante (niveau 0). Dans le cas contraire, elle
649: * est persistante à l'expression (niveau courant).
650: */
651:
652: if ((*s_etat_processus).evaluation_expression_compilee
653: == 'Y')
654: {
655: s_variable_partagee.niveau = 0;
656: }
657: else
658: {
659: s_variable_partagee.niveau =
660: (*s_etat_processus).niveau_courant;
661: }
662:
663: s_variable_partagee.variable_partagee.pointeur =
664: (*s_etat_processus).objet_courant;
665: }
666:
1.56 bertrand 667: // Création du mutex
668:
669: pthread_mutexattr_init(&attributs_mutex);
670: pthread_mutexattr_settype(&attributs_mutex,
671: PTHREAD_MUTEX_RECURSIVE);
672: pthread_mutex_init(&(s_variable_partagee.mutex),
673: &attributs_mutex);
674: pthread_mutexattr_destroy(&attributs_mutex);
675:
1.1 bertrand 676: s_variable_partagee.objet = (*l_emplacement_valeurs).donnee;
677: (*l_emplacement_valeurs).donnee = NULL;
678:
679: if (creation_variable_partagee(s_etat_processus,
680: &s_variable_partagee) == d_erreur)
681: {
682: return;
683: }
684:
1.48 bertrand 685: s_variable.objet = NULL;
686:
687: if (pthread_mutex_unlock(&mutex_creation_variable_partagee)
688: != 0)
1.1 bertrand 689: {
690: (*s_etat_processus).erreur_systeme = d_es_processus;
691: return;
692: }
693: }
694: }
695: else
696: {
697: s_variable.objet = (*l_emplacement_valeurs).donnee;
698: (*l_emplacement_valeurs).donnee = NULL;
699: }
700:
701: l_emplacement_valeurs = (*l_emplacement_valeurs).suivant;
702:
703: if (creation_variable(s_etat_processus, &s_variable,
704: ((*(*s_etat_processus).l_base_pile_systeme)
705: .creation_variables_statiques == d_vrai) ? 'S' : 'V',
706: ((*(*s_etat_processus).l_base_pile_systeme)
707: .creation_variables_partagees == d_vrai) ? 'S' : 'P')
708: == d_erreur)
709: {
710: return;
711: }
712:
713: liberation(s_etat_processus, s_objet);
714: }
715:
716: // Les prochaines variables créées seront forcément du type volatile et
717: // seront obligatoirement privées.
718:
719: if ((*s_etat_processus).l_base_pile_systeme == NULL)
720: {
721: (*s_etat_processus).erreur_systeme = d_es_pile_vide;
722: return;
723: }
724:
725: (*(*s_etat_processus).l_base_pile_systeme).creation_variables_statiques
726: = d_faux;
727: (*(*s_etat_processus).l_base_pile_systeme).creation_variables_partagees
728: = d_faux;
729:
730: for(i = 0; i < nombre_variables; i++)
731: {
732: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
733: &s_objet) == d_erreur)
734: {
735: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
736: return;
737: }
738:
739: liberation(s_etat_processus, s_objet);
740: }
741:
742: (*s_etat_processus).test_instruction = test_instruction;
743: (*s_etat_processus).instruction_valide = instruction_valide;
744:
745: /*
746: * Traitement le cas échéant de l'expression algébrique
747: */
748:
749: if (presence_expression_algebrique == d_vrai)
750: {
1.70 bertrand 751: // Si l'expression algébrique est réduite à un simple nom, il
752: // s'agit toujours d'un nom symbolique. Il faut alors lui retirer
753: // son caractère de constante symbolique pour faire remonter les
754: // erreurs de type 'variable indéfinie'.
755:
756: if ((*s_expression_algebrique).type == NOM)
757: {
758: (*((struct_nom *) (*s_expression_algebrique).objet)).symbole =
759: d_faux;
760: }
761:
1.1 bertrand 762: evaluation(s_etat_processus, s_expression_algebrique, 'N');
763:
1.70 bertrand 764: if ((*s_expression_algebrique).type == NOM)
765: {
766: (*((struct_nom *) (*s_expression_algebrique).objet)).symbole =
767: d_vrai;
768: }
769:
1.1 bertrand 770: if ((*s_etat_processus).mode_execution_programme == 'Y')
771: {
772: liberation(s_etat_processus, s_expression_algebrique);
773: }
774:
1.68 bertrand 775: (*s_etat_processus).autorisation_empilement_programme = 'Y';
1.1 bertrand 776: (*s_etat_processus).niveau_courant--;
777:
1.43 bertrand 778: if (retrait_variables_par_niveau(s_etat_processus) == d_erreur)
1.1 bertrand 779: {
780: return;
781: }
782: }
783:
784: return;
785: }
786:
787:
788: /*
789: ================================================================================
790: Fonction '->list'
791: ================================================================================
792: Entrées : structure processus
793: --------------------------------------------------------------------------------
794: Sorties :
795: --------------------------------------------------------------------------------
796: Effets de bord : néant
797: ================================================================================
798: */
799:
800: void
801: instruction_fleche_list(struct_processus *s_etat_processus)
802: {
803: struct_liste_chainee *l_element_courant;
804:
805: struct_objet *s_objet;
806:
1.54 bertrand 807: integer8 i;
808: integer8 nombre_elements;
1.1 bertrand 809:
810: (*s_etat_processus).erreur_execution = d_ex;
811:
812: if ((*s_etat_processus).affichage_arguments == 'Y')
813: {
814: printf("\n ->LIST ");
815:
816: if ((*s_etat_processus).langue == 'F')
817: {
818: printf("(création d'une liste)\n\n");
819: }
820: else
821: {
822: printf("(create list)\n\n");
823: }
824:
825: printf(" n: %s, %s, %s, %s, %s, %s,\n"
826: " %s, %s, %s, %s, %s,\n"
827: " %s, %s, %s, %s, %s,\n"
828: " %s, %s\n",
829: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
830: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
831: printf(" ...\n");
832: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
833: " %s, %s, %s, %s, %s,\n"
834: " %s, %s, %s, %s, %s,\n"
835: " %s, %s\n",
836: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
837: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
838: printf(" 1: %s\n", d_INT);
839: printf("-> 1: %s\n", d_LST);
840:
841: return;
842: }
843: else if ((*s_etat_processus).test_instruction == 'Y')
844: {
845: (*s_etat_processus).nombre_arguments = -1;
846: return;
847: }
848:
849: if (test_cfsf(s_etat_processus, 31) == d_vrai)
850: {
851: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
852: {
853: return;
854: }
855: }
856:
857: if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
858: {
859: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
860: return;
861: }
862:
863: if ((*(*(*s_etat_processus).l_base_pile).donnee).type != INT)
864: {
865: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
866: return;
867: }
868:
869: nombre_elements = (*((integer8 *) (*(*(*s_etat_processus).l_base_pile)
870: .donnee).objet));
871:
872: if (nombre_elements < 0)
873: {
874:
875: /*
876: -- Opération absurde autorisée sur le calculateur HP-28S -----------------------
877: */
878:
879: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
880: return;
881: }
882:
1.53 bertrand 883: if (nombre_elements >= (*s_etat_processus).hauteur_pile_operationnelle)
1.1 bertrand 884: {
885: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
886: return;
887: }
888:
889: if (test_cfsf(s_etat_processus, 31) == d_vrai)
890: {
891: if (empilement_pile_last(s_etat_processus, nombre_elements + 1)
892: == d_erreur)
893: {
894: return;
895: }
896: }
897:
898: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
899: &s_objet) == d_erreur)
900: {
901: return;
902: }
903:
904: liberation(s_etat_processus, s_objet);
905: l_element_courant = NULL;
906:
907: for(i = 0; i < nombre_elements; i++)
908: {
909: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
910: &s_objet) == d_erreur)
911: {
912: return;
913: }
914:
915: if (empilement(s_etat_processus, &l_element_courant, s_objet)
916: == d_erreur)
917: {
918: return;
919: }
920: }
921:
922: if ((s_objet = allocation(s_etat_processus, LST)) == NULL)
923: {
924: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
925: return;
926: }
927:
928: (*s_objet).objet = (void *) l_element_courant;
929:
930: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
931: s_objet) == d_erreur)
932: {
933: return;
934: }
935:
936: return;
937: }
938:
939:
940: /*
941: ================================================================================
942: Fonction 'for'
943: ================================================================================
944: Entrées : structure processus
945: --------------------------------------------------------------------------------
946: Sorties :
947: --------------------------------------------------------------------------------
948: Effets de bord : néant
949: ================================================================================
950: */
951:
952: void
953: instruction_for(struct_processus *s_etat_processus)
954: {
955: struct_objet *s_objet_1;
956: struct_objet *s_objet_2;
957: struct_objet *s_objet_3;
958:
959: struct_variable s_variable;
960:
961: unsigned char instruction_valide;
962: unsigned char *tampon;
963: unsigned char test_instruction;
964:
965: (*s_etat_processus).erreur_execution = d_ex;
966:
967: if ((*s_etat_processus).affichage_arguments == 'Y')
968: {
969: printf("\n FOR ");
970:
971: if ((*s_etat_processus).langue == 'F')
972: {
973: printf("(boucle définie avec compteur)\n\n");
974: }
975: else
976: {
977: printf("(define a counter-based loop)\n\n");
978: }
979:
980: if ((*s_etat_processus).langue == 'F')
981: {
982: printf(" Utilisation :\n\n");
983: }
984: else
985: {
986: printf(" Usage:\n\n");
987: }
988:
989: printf(" %s/%s %s/%s FOR (variable)\n", d_INT, d_REL,
990: d_INT, d_REL);
991: printf(" (expression)\n");
992: printf(" [EXIT]/[CYCLE]\n");
993: printf(" ...\n");
994: printf(" NEXT\n\n");
995:
996: printf(" %s/%s %s/%s FOR (variable)\n", d_INT, d_REL,
997: d_INT, d_REL);
998: printf(" (expression)\n");
999: printf(" [EXIT]/[CYCLE]\n");
1000: printf(" ...\n");
1001: printf(" %s/%s STEP\n", d_INT, d_REL);
1002:
1003: return;
1004: }
1005: else if ((*s_etat_processus).test_instruction == 'Y')
1006: {
1007: (*s_etat_processus).nombre_arguments = -1;
1008: return;
1009: }
1010:
1011: if ((*s_etat_processus).erreur_systeme != d_es)
1012: {
1013: return;
1014: }
1015:
1016: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1017: {
1018: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1019: {
1020: return;
1021: }
1022: }
1023:
1024: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1025: &s_objet_1) == d_erreur)
1026: {
1027: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1028: return;
1029: }
1030:
1031: if (((*s_objet_1).type != INT) &&
1032: ((*s_objet_1).type != REL))
1033: {
1034: liberation(s_etat_processus, s_objet_1);
1035:
1036: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
1037: return;
1038: }
1039:
1040: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1041: &s_objet_2) == d_erreur)
1042: {
1043: liberation(s_etat_processus, s_objet_1);
1044:
1045: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1046: return;
1047: }
1048:
1.61 bertrand 1049: if (((*s_objet_2).type != INT) && ((*s_objet_2).type != REL))
1.1 bertrand 1050: {
1051: liberation(s_etat_processus, s_objet_1);
1052: liberation(s_etat_processus, s_objet_2);
1053:
1054: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
1055: return;
1056: }
1057:
1.41 bertrand 1058: empilement_pile_systeme(s_etat_processus);
1059:
1060: if ((*s_etat_processus).erreur_systeme != d_es)
1061: {
1062: return;
1063: }
1064:
1.1 bertrand 1065: if ((*s_etat_processus).mode_execution_programme == 'Y')
1066: {
1.61 bertrand 1067: tampon = (*s_etat_processus).instruction_courante;
1068: test_instruction = (*s_etat_processus).test_instruction;
1069: instruction_valide = (*s_etat_processus).instruction_valide;
1070: (*s_etat_processus).test_instruction = 'Y';
1071:
1.1 bertrand 1072: if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
1073: {
1074: return;
1075: }
1076:
1077: analyse(s_etat_processus, NULL);
1078:
1079: if ((*s_etat_processus).instruction_valide == 'Y')
1080: {
1081: liberation(s_etat_processus, s_objet_1);
1082: liberation(s_etat_processus, s_objet_2);
1083:
1084: free((*s_etat_processus).instruction_courante);
1085: (*s_etat_processus).instruction_courante = tampon;
1.61 bertrand 1086: (*s_etat_processus).instruction_valide = instruction_valide;
1087: (*s_etat_processus).test_instruction = test_instruction;
1.1 bertrand 1088:
1.41 bertrand 1089: depilement_pile_systeme(s_etat_processus);
1090:
1.1 bertrand 1091: (*s_etat_processus).erreur_execution = d_ex_nom_reserve;
1092: return;
1093: }
1094:
1.65 bertrand 1095: (*s_etat_processus).type_en_cours = NON;
1.1 bertrand 1096: recherche_type(s_etat_processus);
1097:
1098: free((*s_etat_processus).instruction_courante);
1099: (*s_etat_processus).instruction_courante = tampon;
1.61 bertrand 1100: (*s_etat_processus).instruction_valide = instruction_valide;
1101: (*s_etat_processus).test_instruction = test_instruction;
1.1 bertrand 1102:
1103: if ((*s_etat_processus).erreur_execution != d_ex)
1104: {
1105: liberation(s_etat_processus, s_objet_1);
1106: liberation(s_etat_processus, s_objet_2);
1107:
1.41 bertrand 1108: depilement_pile_systeme(s_etat_processus);
1.1 bertrand 1109: return;
1110: }
1111:
1112: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1113: &s_objet_3) == d_erreur)
1114: {
1115: liberation(s_etat_processus, s_objet_1);
1116: liberation(s_etat_processus, s_objet_2);
1117:
1.41 bertrand 1118: depilement_pile_systeme(s_etat_processus);
1119:
1.1 bertrand 1120: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1121: return;
1122: }
1123:
1124: (*(*s_etat_processus).l_base_pile_systeme)
1125: .origine_routine_evaluation = 'N';
1126: }
1127: else
1128: {
1129: if ((*s_etat_processus).expression_courante == NULL)
1130: {
1.41 bertrand 1131: depilement_pile_systeme(s_etat_processus);
1.1 bertrand 1132: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1133: return;
1134: }
1135:
1136: (*s_etat_processus).expression_courante = (*(*s_etat_processus)
1137: .expression_courante).suivant;
1138:
1139: if ((s_objet_3 = copie_objet(s_etat_processus,
1140: (*(*s_etat_processus).expression_courante)
1141: .donnee, 'P')) == NULL)
1142: {
1143: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1144: return;
1145: }
1146:
1147: (*(*s_etat_processus).l_base_pile_systeme)
1148: .origine_routine_evaluation = 'Y';
1149: }
1150:
1151: if ((*s_objet_3).type != NOM)
1152: {
1153: liberation(s_etat_processus, s_objet_1);
1154: liberation(s_etat_processus, s_objet_2);
1155:
1.41 bertrand 1156: depilement_pile_systeme(s_etat_processus);
1157:
1.1 bertrand 1158: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
1159: return;
1160: }
1161: else if ((*((struct_nom *) (*s_objet_3).objet)).symbole == d_vrai)
1162: {
1163: liberation(s_etat_processus, s_objet_1);
1164: liberation(s_etat_processus, s_objet_2);
1165:
1.41 bertrand 1166: depilement_pile_systeme(s_etat_processus);
1167:
1.1 bertrand 1168: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
1169: return;
1170: }
1171:
1172: (*s_etat_processus).niveau_courant++;
1173:
1174: if ((s_variable.nom = malloc((strlen(
1175: (*((struct_nom *) (*s_objet_3).objet)).nom) + 1) *
1176: sizeof(unsigned char))) == NULL)
1177: {
1178: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1179: return;
1180: }
1181:
1182: strcpy(s_variable.nom, (*((struct_nom *) (*s_objet_3).objet)).nom);
1183: s_variable.niveau = (*s_etat_processus).niveau_courant;
1184: s_variable.objet = s_objet_2;
1185:
1186: if (creation_variable(s_etat_processus, &s_variable, 'V', 'P') == d_erreur)
1187: {
1188: return;
1189: }
1190:
1191: liberation(s_etat_processus, s_objet_3);
1192:
1193: (*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = s_objet_1;
1194:
1195: if ((*s_etat_processus).mode_execution_programme == 'Y')
1196: {
1197: (*(*s_etat_processus).l_base_pile_systeme).adresse_retour =
1198: (*s_etat_processus).position_courante;
1199: }
1200: else
1201: {
1202: (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour =
1203: (*s_etat_processus).expression_courante;
1204: }
1205:
1206: (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'F';
1207:
1208: if (((*(*s_etat_processus).l_base_pile_systeme).nom_variable =
1209: malloc((strlen(s_variable.nom) + 1) *
1210: sizeof(unsigned char))) == NULL)
1211: {
1212: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1213: return;
1214: }
1215:
1216: strcpy((*(*s_etat_processus).l_base_pile_systeme).nom_variable,
1217: s_variable.nom);
1218:
1219: return;
1220: }
1221:
1222:
1223: /*
1224: ================================================================================
1225: Fonction 'fc?'
1226: ================================================================================
1227: Entrées : structure processus
1228: --------------------------------------------------------------------------------
1229: Sorties :
1230: --------------------------------------------------------------------------------
1231: Effets de bord : néant
1232: ================================================================================
1233: */
1234:
1235: void
1236: instruction_fc_test(struct_processus *s_etat_processus)
1237: {
1238: struct_objet *s_objet_argument;
1239: struct_objet *s_objet_resultat;
1240:
1241: (*s_etat_processus).erreur_execution = d_ex;
1242:
1243: if ((*s_etat_processus).affichage_arguments == 'Y')
1244: {
1245: printf("\n FC? ");
1246:
1247: if ((*s_etat_processus).langue == 'F')
1248: {
1249: printf("(teste si un drapeau est désarmé)\n\n");
1250: }
1251: else
1252: {
1253: printf("(test if flag is clear)\n\n");
1254: }
1255:
1256: printf(" 1: %s\n", d_INT);
1257: printf("-> 1: %s\n", d_INT);
1258:
1259: return;
1260: }
1261: else if ((*s_etat_processus).test_instruction == 'Y')
1262: {
1263: (*s_etat_processus).nombre_arguments = -1;
1264: return;
1265: }
1266:
1267: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1268: {
1269: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1270: {
1271: return;
1272: }
1273: }
1274:
1275: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1276: &s_objet_argument) == d_erreur)
1277: {
1278: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1279: return;
1280: }
1281:
1282: if ((*s_objet_argument).type == INT)
1283: {
1284: if (((*((integer8 *) (*s_objet_argument).objet)) < 1) ||
1285: ((*((integer8 *) (*s_objet_argument).objet)) > 64))
1286: {
1287: liberation(s_etat_processus, s_objet_argument);
1288:
1289: (*s_etat_processus).erreur_execution = d_ex_drapeau_inexistant;
1290: return;
1291: }
1292:
1293: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1294: == NULL)
1295: {
1296: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1297: return;
1298: }
1299:
1300: if (test_cfsf(s_etat_processus, (unsigned char) (*((integer8 *)
1301: (*s_objet_argument).objet))) == d_vrai)
1302: {
1303: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1304: }
1305: else
1306: {
1307: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
1308: }
1309: }
1310: else
1311: {
1312: liberation(s_etat_processus, s_objet_argument);
1313:
1314: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1315: return;
1316: }
1317:
1318: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1319: s_objet_resultat) == d_erreur)
1320: {
1321: return;
1322: }
1323:
1324: liberation(s_etat_processus, s_objet_argument);
1325:
1326: return;
1327: }
1328:
1329:
1330: /*
1331: ================================================================================
1332: Fonction 'fs?'
1333: ================================================================================
1334: Entrées : structure processus
1335: --------------------------------------------------------------------------------
1336: Sorties :
1337: --------------------------------------------------------------------------------
1338: Effets de bord : néant
1339: ================================================================================
1340: */
1341:
1342: void
1343: instruction_fs_test(struct_processus *s_etat_processus)
1344: {
1345: struct_objet *s_objet_argument;
1346: struct_objet *s_objet_resultat;
1347:
1348: (*s_etat_processus).erreur_execution = d_ex;
1349:
1350: if ((*s_etat_processus).affichage_arguments == 'Y')
1351: {
1352: printf("\n FS? ");
1353:
1354: if ((*s_etat_processus).langue == 'F')
1355: {
1356: printf("(teste si un drapeau est armé)\n\n");
1357: }
1358: else
1359: {
1360: printf("(test if flag is set)\n\n");
1361: }
1362:
1363: printf(" 1: %s\n", d_INT);
1364: printf("-> 1: %s\n", d_INT);
1365:
1366: return;
1367: }
1368: else if ((*s_etat_processus).test_instruction == 'Y')
1369: {
1370: (*s_etat_processus).nombre_arguments = -1;
1371: return;
1372: }
1373:
1374: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1375: {
1376: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1377: {
1378: return;
1379: }
1380: }
1381:
1382: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1383: &s_objet_argument) == d_erreur)
1384: {
1385: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1386: return;
1387: }
1388:
1389: if ((*s_objet_argument).type == INT)
1390: {
1391: if (((*((integer8 *) (*s_objet_argument).objet)) < 1) ||
1392: ((*((integer8 *) (*s_objet_argument).objet)) > 64))
1393: {
1394: liberation(s_etat_processus, s_objet_argument);
1395:
1396: (*s_etat_processus).erreur_execution = d_ex_drapeau_inexistant;
1397: return;
1398: }
1399:
1400: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1401: == NULL)
1402: {
1403: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1404: return;
1405: }
1406:
1407: if (test_cfsf(s_etat_processus, (unsigned char) (*((integer8 *)
1408: (*s_objet_argument).objet))) == d_vrai)
1409: {
1410: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
1411: }
1412: else
1413: {
1414: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1415: }
1416: }
1417: else
1418: {
1419: liberation(s_etat_processus, s_objet_argument);
1420:
1421: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1422: return;
1423: }
1424:
1425: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1426: s_objet_resultat) == d_erreur)
1427: {
1428: return;
1429: }
1430:
1431: liberation(s_etat_processus, s_objet_argument);
1432:
1433: return;
1434: }
1435:
1436:
1437: /*
1438: ================================================================================
1439: Fonction 'fs?s'
1440: ================================================================================
1441: Entrées : structure processus
1442: --------------------------------------------------------------------------------
1443: Sorties :
1444: --------------------------------------------------------------------------------
1445: Effets de bord : néant
1446: ================================================================================
1447: */
1448:
1449: void
1450: instruction_fs_test_s(struct_processus *s_etat_processus)
1451: {
1452: (*s_etat_processus).erreur_execution = d_ex;
1453:
1454: if ((*s_etat_processus).affichage_arguments == 'Y')
1455: {
1456: printf("\n FS?S ");
1457:
1458: if ((*s_etat_processus).langue == 'F')
1459: {
1460: printf("(teste si un drapeau est armé et arme le drapeau)\n\n");
1461: }
1462: else
1463: {
1464: printf("(test if flag is set and set flag)\n\n");
1465: }
1466:
1467: printf(" 1: %s\n", d_INT);
1468: printf("-> 1: %s\n", d_INT);
1469:
1470: return;
1471: }
1472: else if ((*s_etat_processus).test_instruction == 'Y')
1473: {
1474: (*s_etat_processus).nombre_arguments = -1;
1475: return;
1476: }
1477:
1478: instruction_dup(s_etat_processus);
1479:
1480: if (((*s_etat_processus).erreur_systeme != d_es) ||
1481: ((*s_etat_processus).erreur_execution != d_ex))
1482: {
1483: return;
1484: }
1485:
1486: instruction_fs_test(s_etat_processus);
1487:
1488: if (((*s_etat_processus).erreur_systeme != d_es) ||
1489: ((*s_etat_processus).erreur_execution != d_ex))
1490: {
1491: return;
1492: }
1493:
1494: if (((*s_etat_processus).erreur_systeme != d_es) ||
1495: ((*s_etat_processus).erreur_execution != d_ex))
1496: {
1497: return;
1498: }
1499:
1500: instruction_swap(s_etat_processus);
1501:
1502: if (((*s_etat_processus).erreur_systeme != d_es) ||
1503: ((*s_etat_processus).erreur_execution != d_ex))
1504: {
1505: return;
1506: }
1507:
1508: instruction_sf(s_etat_processus);
1509:
1510: return;
1511: }
1512:
1513:
1514: /*
1515: ================================================================================
1516: Fonction 'fs?c'
1517: ================================================================================
1518: Entrées : structure processus
1519: --------------------------------------------------------------------------------
1520: Sorties :
1521: --------------------------------------------------------------------------------
1522: Effets de bord : néant
1523: ================================================================================
1524: */
1525:
1526: void
1527: instruction_fs_test_c(struct_processus *s_etat_processus)
1528: {
1529: (*s_etat_processus).erreur_execution = d_ex;
1530:
1531: if ((*s_etat_processus).affichage_arguments == 'Y')
1532: {
1533: printf("\n FS?C ");
1534:
1535: if ((*s_etat_processus).langue == 'F')
1536: {
1537: printf("(teste si un drapeau est armé et désarme le drapeau)\n\n");
1538: }
1539: else
1540: {
1541: printf("(test if flag is set and clear flag)\n\n");
1542: }
1543:
1544: printf(" 1: %s\n", d_INT);
1545: printf("-> 1: %s\n", d_INT);
1546:
1547: return;
1548: }
1549: else if ((*s_etat_processus).test_instruction == 'Y')
1550: {
1551: (*s_etat_processus).nombre_arguments = -1;
1552: return;
1553: }
1554:
1555: instruction_dup(s_etat_processus);
1556:
1557: if (((*s_etat_processus).erreur_systeme != d_es) ||
1558: ((*s_etat_processus).erreur_execution != d_ex))
1559: {
1560: return;
1561: }
1562:
1563: instruction_fs_test(s_etat_processus);
1564:
1565: if (((*s_etat_processus).erreur_systeme != d_es) ||
1566: ((*s_etat_processus).erreur_execution != d_ex))
1567: {
1568: return;
1569: }
1570:
1571: if (((*s_etat_processus).erreur_systeme != d_es) ||
1572: ((*s_etat_processus).erreur_execution != d_ex))
1573: {
1574: return;
1575: }
1576:
1577: instruction_swap(s_etat_processus);
1578:
1579: if (((*s_etat_processus).erreur_systeme != d_es) ||
1580: ((*s_etat_processus).erreur_execution != d_ex))
1581: {
1582: return;
1583: }
1584:
1585: instruction_cf(s_etat_processus);
1586:
1587: return;
1588: }
1589:
1590:
1591: /*
1592: ================================================================================
1593: Fonction 'fc?s'
1594: ================================================================================
1595: Entrées : structure processus
1596: --------------------------------------------------------------------------------
1597: Sorties :
1598: --------------------------------------------------------------------------------
1599: Effets de bord : néant
1600: ================================================================================
1601: */
1602:
1603: void
1604: instruction_fc_test_s(struct_processus *s_etat_processus)
1605: {
1606: (*s_etat_processus).erreur_execution = d_ex;
1607:
1608: if ((*s_etat_processus).affichage_arguments == 'Y')
1609: {
1610: printf("\n FC?S ");
1611:
1612: if ((*s_etat_processus).langue == 'F')
1613: {
1614: printf("(teste si un drapeau est désarmé et arme le drapeau)\n\n");
1615: }
1616: else
1617: {
1618: printf("(test if flag is clear and set flag)\n\n");
1619: }
1620:
1621: printf(" 1: %s\n", d_INT);
1622: printf("-> 1: %s\n", d_INT);
1623:
1624: return;
1625: }
1626: else if ((*s_etat_processus).test_instruction == 'Y')
1627: {
1628: (*s_etat_processus).nombre_arguments = -1;
1629: return;
1630: }
1631:
1632: instruction_dup(s_etat_processus);
1633:
1634: if (((*s_etat_processus).erreur_systeme != d_es) ||
1635: ((*s_etat_processus).erreur_execution != d_ex))
1636: {
1637: return;
1638: }
1639:
1640: instruction_fc_test(s_etat_processus);
1641:
1642: if (((*s_etat_processus).erreur_systeme != d_es) ||
1643: ((*s_etat_processus).erreur_execution != d_ex))
1644: {
1645: return;
1646: }
1647:
1648: if (((*s_etat_processus).erreur_systeme != d_es) ||
1649: ((*s_etat_processus).erreur_execution != d_ex))
1650: {
1651: return;
1652: }
1653:
1654: instruction_swap(s_etat_processus);
1655:
1656: if (((*s_etat_processus).erreur_systeme != d_es) ||
1657: ((*s_etat_processus).erreur_execution != d_ex))
1658: {
1659: return;
1660: }
1661:
1662: instruction_sf(s_etat_processus);
1663:
1664: return;
1665: }
1666:
1667:
1668: /*
1669: ================================================================================
1670: Fonction 'fc?c'
1671: ================================================================================
1672: Entrées : structure processus
1673: --------------------------------------------------------------------------------
1674: Sorties :
1675: --------------------------------------------------------------------------------
1676: Effets de bord : néant
1677: ================================================================================
1678: */
1679:
1680: void
1681: instruction_fc_test_c(struct_processus *s_etat_processus)
1682: {
1683: (*s_etat_processus).erreur_execution = d_ex;
1684:
1685: if ((*s_etat_processus).affichage_arguments == 'Y')
1686: {
1687: printf("\n FC?C ");
1688:
1689: if ((*s_etat_processus).langue == 'F')
1690: {
1691: printf("(teste si un drapeau est désarmé et désarme le drapeau)"
1692: "\n\n");
1693: }
1694: else
1695: {
1696: printf("(test if flag is clear and clear flag)\n\n");
1697: }
1698:
1699: printf(" 1: %s\n", d_INT);
1700: printf("-> 1: %s\n", d_INT);
1701:
1702: return;
1703: }
1704: else if ((*s_etat_processus).test_instruction == 'Y')
1705: {
1706: (*s_etat_processus).nombre_arguments = -1;
1707: return;
1708: }
1709:
1710: instruction_dup(s_etat_processus);
1711:
1712: if (((*s_etat_processus).erreur_systeme != d_es) ||
1713: ((*s_etat_processus).erreur_execution != d_ex))
1714: {
1715: return;
1716: }
1717:
1718: instruction_fc_test(s_etat_processus);
1719:
1720: if (((*s_etat_processus).erreur_systeme != d_es) ||
1721: ((*s_etat_processus).erreur_execution != d_ex))
1722: {
1723: return;
1724: }
1725:
1726: if (((*s_etat_processus).erreur_systeme != d_es) ||
1727: ((*s_etat_processus).erreur_execution != d_ex))
1728: {
1729: return;
1730: }
1731:
1732: instruction_swap(s_etat_processus);
1733:
1734: if (((*s_etat_processus).erreur_systeme != d_es) ||
1735: ((*s_etat_processus).erreur_execution != d_ex))
1736: {
1737: return;
1738: }
1739:
1740: instruction_cf(s_etat_processus);
1741:
1742: return;
1743: }
1744:
1745:
1746: /*
1747: ================================================================================
1748: Fonction 'fact'
1749: ================================================================================
1750: Entrées :
1751: --------------------------------------------------------------------------------
1752: Sorties :
1753: --------------------------------------------------------------------------------
1754: Effets de bord : néant
1755: ================================================================================
1756: */
1757:
1758: void
1759: instruction_fact(struct_processus *s_etat_processus)
1760: {
1761: logical1 depassement;
1762:
1763: real8 produit;
1764:
1765: integer8 i;
1766: integer8 ifact;
1767: integer8 tampon;
1768:
1769: struct_liste_chainee *l_element_courant;
1770: struct_liste_chainee *l_element_precedent;
1771:
1772: struct_objet *s_copie_argument;
1773: struct_objet *s_objet_argument;
1774: struct_objet *s_objet_resultat;
1775:
1776: (*s_etat_processus).erreur_execution = d_ex;
1777:
1778: if ((*s_etat_processus).affichage_arguments == 'Y')
1779: {
1780: printf("\n FACT ");
1781:
1782: if ((*s_etat_processus).langue == 'F')
1783: {
1784: printf("(factorielle)\n\n");
1785: }
1786: else
1787: {
1788: printf("(factorial)\n\n");
1789: }
1790:
1791: printf(" 1: %s\n", d_INT);
1792: printf("-> 1: %s, %s\n\n", d_INT, d_REL);
1793:
1794: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1795: printf("-> 1: %s\n\n", d_ALG);
1796:
1797: printf(" 1: %s\n", d_RPN);
1798: printf("-> 1: %s\n", d_RPN);
1799:
1800: return;
1801: }
1802: else if ((*s_etat_processus).test_instruction == 'Y')
1803: {
1804: (*s_etat_processus).nombre_arguments = 1;
1805: return;
1806: }
1807:
1808: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1809: {
1810: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1811: {
1812: return;
1813: }
1814: }
1815:
1816: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1817: &s_objet_argument) == d_erreur)
1818: {
1819: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1820: return;
1821: }
1822:
1823: /*
1824: --------------------------------------------------------------------------------
1825: Calcul de la factorielle d'un entier (résultat réel)
1826: --------------------------------------------------------------------------------
1827: */
1828:
1829: if ((*s_objet_argument).type == INT)
1830: {
1831: if ((*((integer8 *) (*s_objet_argument).objet)) < 0)
1832: {
1833: if (test_cfsf(s_etat_processus, 59) == d_vrai)
1834: {
1835: liberation(s_etat_processus, s_objet_argument);
1836:
1837: (*s_etat_processus).exception = d_ep_overflow;
1838: return;
1839: }
1840: else
1841: {
1842: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1843: == NULL)
1844: {
1845: (*s_etat_processus).erreur_systeme =
1846: d_es_allocation_memoire;
1847: return;
1848: }
1849:
1850: (*((real8 *) (*s_objet_resultat).objet)) =
1851: ((double) 1) / ((double) 0);
1852: }
1853: }
1854: else
1855: {
1856: ifact = 1;
1857: depassement = d_faux;
1858:
1859: for (i = 1; i <= (*((integer8 *) (*s_objet_argument).objet)); i++)
1860: {
1861: if (depassement_multiplication(&ifact, &i, &tampon) == d_erreur)
1862: {
1863: depassement = d_vrai;
1864: break;
1865: }
1866:
1867: ifact = tampon;
1868: }
1869:
1870: if (depassement == d_faux)
1871: {
1872: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1873: == NULL)
1874: {
1875: (*s_etat_processus).erreur_systeme =
1876: d_es_allocation_memoire;
1877: return;
1878: }
1879:
1880: (*((integer8 *) (*s_objet_resultat).objet)) = ifact;
1881: }
1882: else
1883: {
1884: produit = 1;
1885:
1886: for (i = 1; i <= (*((integer8 *) (*s_objet_argument).objet));
1887: i++)
1888: {
1.53 bertrand 1889: produit *= (real8) i;
1.1 bertrand 1890: }
1891:
1892: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1893: == NULL)
1894: {
1895: (*s_etat_processus).erreur_systeme =
1896: d_es_allocation_memoire;
1897: return;
1898: }
1899:
1900: (*((real8 *) (*s_objet_resultat).objet)) = produit;
1901: }
1902: }
1903: }
1904:
1905: /*
1906: --------------------------------------------------------------------------------
1907: Factorielle d'un nom
1908: --------------------------------------------------------------------------------
1909: */
1910:
1911: else if ((*s_objet_argument).type == NOM)
1912: {
1913: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
1914: == NULL)
1915: {
1916: (*s_etat_processus).erreur_systeme =
1917: d_es_allocation_memoire;
1918: return;
1919: }
1920:
1921: if (((*s_objet_resultat).objet =
1922: allocation_maillon(s_etat_processus)) == NULL)
1923: {
1924: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1925: return;
1926: }
1927:
1928: l_element_courant = (*s_objet_resultat).objet;
1929:
1930: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1931: == NULL)
1932: {
1933: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1934: return;
1935: }
1936:
1937: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1938: .nombre_arguments = 0;
1939: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1940: .fonction = instruction_vers_niveau_superieur;
1941:
1942: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1943: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1944: {
1945: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1946: return;
1947: }
1948:
1949: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1950: .nom_fonction, "<<");
1951:
1952: if (((*l_element_courant).suivant =
1953: allocation_maillon(s_etat_processus)) == NULL)
1954: {
1955: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1956: return;
1957: }
1958:
1959: l_element_courant = (*l_element_courant).suivant;
1960: (*l_element_courant).donnee = s_objet_argument;
1961:
1962: if (((*l_element_courant).suivant =
1963: allocation_maillon(s_etat_processus)) == NULL)
1964: {
1965: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1966: return;
1967: }
1968:
1969: l_element_courant = (*l_element_courant).suivant;
1970:
1971: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1972: == NULL)
1973: {
1974: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1975: return;
1976: }
1977:
1978: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1979: .nombre_arguments = 1;
1980: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1981: .fonction = instruction_fact;
1982:
1983: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1984: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
1985: {
1986: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1987: return;
1988: }
1989:
1990: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1991: .nom_fonction, "FACT");
1992:
1993: if (((*l_element_courant).suivant =
1994: allocation_maillon(s_etat_processus)) == NULL)
1995: {
1996: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1997: return;
1998: }
1999:
2000: l_element_courant = (*l_element_courant).suivant;
2001:
2002: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2003: == NULL)
2004: {
2005: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2006: return;
2007: }
2008:
2009: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2010: .nombre_arguments = 0;
2011: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2012: .fonction = instruction_vers_niveau_inferieur;
2013:
2014: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2015: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2016: {
2017: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2018: return;
2019: }
2020:
2021: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2022: .nom_fonction, ">>");
2023:
2024: (*l_element_courant).suivant = NULL;
2025: s_objet_argument = NULL;
2026: }
2027:
2028: /*
2029: --------------------------------------------------------------------------------
2030: Factorielle d'une expression
2031: --------------------------------------------------------------------------------
2032: */
2033:
2034: else if (((*s_objet_argument).type == ALG) ||
2035: ((*s_objet_argument).type == RPN))
2036: {
2037: if ((s_copie_argument = copie_objet(s_etat_processus,
2038: s_objet_argument, 'N')) == NULL)
2039: {
2040: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2041: return;
2042: }
2043:
2044: l_element_courant = (struct_liste_chainee *)
2045: (*s_copie_argument).objet;
2046: l_element_precedent = l_element_courant;
2047:
2048: while((*l_element_courant).suivant != NULL)
2049: {
2050: l_element_precedent = l_element_courant;
2051: l_element_courant = (*l_element_courant).suivant;
2052: }
2053:
2054: if (((*l_element_precedent).suivant =
2055: allocation_maillon(s_etat_processus)) == NULL)
2056: {
2057: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2058: return;
2059: }
2060:
2061: if (((*(*l_element_precedent).suivant).donnee =
2062: allocation(s_etat_processus, FCT)) == NULL)
2063: {
2064: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2065: return;
2066: }
2067:
2068: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2069: .donnee).objet)).nombre_arguments = 1;
2070: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2071: .donnee).objet)).fonction = instruction_fact;
2072:
2073: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2074: .suivant).donnee).objet)).nom_fonction =
2075: malloc(5 * sizeof(unsigned char))) == NULL)
2076: {
2077: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2078: return;
2079: }
2080:
2081: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2082: .suivant).donnee).objet)).nom_fonction, "FACT");
2083:
2084: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2085:
2086: s_objet_resultat = s_copie_argument;
2087: }
2088:
2089: /*
2090: --------------------------------------------------------------------------------
2091: Factorielle impossible à réaliser
2092: --------------------------------------------------------------------------------
2093: */
2094:
2095: else
2096: {
2097: liberation(s_etat_processus, s_objet_argument);
2098:
2099: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2100: return;
2101: }
2102:
2103: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2104: s_objet_resultat) == d_erreur)
2105: {
2106: return;
2107: }
2108:
2109: liberation(s_etat_processus, s_objet_argument);
2110:
2111: return;
2112: }
2113:
2114:
2115: /*
2116: ================================================================================
2117: Fonction 'floor'
2118: ================================================================================
2119: Entrées :
2120: --------------------------------------------------------------------------------
2121: Sorties :
2122: --------------------------------------------------------------------------------
2123: Effets de bord : néant
2124: ================================================================================
2125: */
2126:
2127: void
2128: instruction_floor(struct_processus *s_etat_processus)
2129: {
2130: struct_liste_chainee *l_element_courant;
2131: struct_liste_chainee *l_element_precedent;
2132:
2133: struct_objet *s_copie_argument;
2134: struct_objet *s_objet_argument;
2135: struct_objet *s_objet_resultat;
2136:
2137: (*s_etat_processus).erreur_execution = d_ex;
2138:
2139: if ((*s_etat_processus).affichage_arguments == 'Y')
2140: {
2141: printf("\n FLOOR ");
2142:
2143: if ((*s_etat_processus).langue == 'F')
2144: {
2145: printf("(valeur plancher)\n\n");
2146: }
2147: else
2148: {
2149: printf("(floor value)\n\n");
2150: }
2151:
2152: printf(" 1: %s\n", d_INT);
2153: printf("-> 1: %s\n\n", d_INT);
2154:
2155: printf(" 1: %s\n", d_REL);
2156: printf("-> 1: %s, %s\n\n", d_INT, d_REL);
2157:
2158: printf(" 1: %s, %s\n", d_NOM, d_ALG);
2159: printf("-> 1: %s\n\n", d_ALG);
2160:
2161: printf(" 1: %s\n", d_RPN);
2162: printf("-> 1: %s\n", d_RPN);
2163:
2164: return;
2165: }
2166: else if ((*s_etat_processus).test_instruction == 'Y')
2167: {
2168: (*s_etat_processus).nombre_arguments = 1;
2169: return;
2170: }
2171:
2172: if (test_cfsf(s_etat_processus, 31) == d_vrai)
2173: {
2174: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
2175: {
2176: return;
2177: }
2178: }
2179:
2180: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2181: &s_objet_argument) == d_erreur)
2182: {
2183: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2184: return;
2185: }
2186:
2187: /*
2188: --------------------------------------------------------------------------------
2189: Plancher d'un entier
2190: --------------------------------------------------------------------------------
2191: */
2192:
2193: if ((*s_objet_argument).type == INT)
2194: {
2195: s_objet_resultat = s_objet_argument;
2196: s_objet_argument = NULL;
2197: }
2198:
2199: /*
2200: --------------------------------------------------------------------------------
2201: Plancher d'un réel
2202: --------------------------------------------------------------------------------
2203: */
2204:
2205: else if ((*s_objet_argument).type == REL)
2206: {
2207: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
2208: {
2209: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2210: return;
2211: }
2212:
1.53 bertrand 2213: (*((integer8 *) (*s_objet_resultat).objet)) = (integer8)
1.1 bertrand 2214: floor((*((real8 *) (*s_objet_argument).objet)));
2215:
2216: if (!((((*((integer8 *) (*s_objet_resultat).objet)) <
2217: (*((real8 *) (*s_objet_argument).objet))) && (((*((integer8 *)
2218: (*s_objet_resultat).objet)) + 1) > (*((real8 *)
2219: (*s_objet_argument).objet))))))
2220: {
2221: free((*s_objet_resultat).objet);
2222:
2223: if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL)
2224: {
2225: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2226: return;
2227: }
2228:
2229: (*s_objet_resultat).type = REL;
2230: (*((real8 *) (*s_objet_resultat).objet)) =
2231: ceil((*((real8 *) (*s_objet_argument).objet)));
2232: }
2233: }
2234:
2235: /*
2236: --------------------------------------------------------------------------------
2237: Plancher d'un nom
2238: --------------------------------------------------------------------------------
2239: */
2240:
2241: else if ((*s_objet_argument).type == NOM)
2242: {
2243: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
2244: {
2245: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2246: return;
2247: }
2248:
2249: if (((*s_objet_resultat).objet =
2250: allocation_maillon(s_etat_processus)) == NULL)
2251: {
2252: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2253: return;
2254: }
2255:
2256: l_element_courant = (*s_objet_resultat).objet;
2257:
2258: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2259: == NULL)
2260: {
2261: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2262: return;
2263: }
2264:
2265: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2266: .nombre_arguments = 0;
2267: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2268: .fonction = instruction_vers_niveau_superieur;
2269:
2270: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2271: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2272: {
2273: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2274: return;
2275: }
2276:
2277: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2278: .nom_fonction, "<<");
2279:
2280: if (((*l_element_courant).suivant =
2281: allocation_maillon(s_etat_processus)) == NULL)
2282: {
2283: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2284: return;
2285: }
2286:
2287: l_element_courant = (*l_element_courant).suivant;
2288: (*l_element_courant).donnee = s_objet_argument;
2289:
2290: if (((*l_element_courant).suivant =
2291: allocation_maillon(s_etat_processus)) == NULL)
2292: {
2293: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2294: return;
2295: }
2296:
2297: l_element_courant = (*l_element_courant).suivant;
2298:
2299: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2300: == NULL)
2301: {
2302: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2303: return;
2304: }
2305:
2306: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2307: .nombre_arguments = 1;
2308: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2309: .fonction = instruction_floor;
2310:
2311: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2312: .nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL)
2313: {
2314: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2315: return;
2316: }
2317:
2318: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2319: .nom_fonction, "FLOOR");
2320:
2321: if (((*l_element_courant).suivant =
2322: allocation_maillon(s_etat_processus)) == NULL)
2323: {
2324: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2325: return;
2326: }
2327:
2328: l_element_courant = (*l_element_courant).suivant;
2329:
2330: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2331: == NULL)
2332: {
2333: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2334: return;
2335: }
2336:
2337: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2338: .nombre_arguments = 0;
2339: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2340: .fonction = instruction_vers_niveau_inferieur;
2341:
2342: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2343: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2344: {
2345: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2346: return;
2347: }
2348:
2349: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2350: .nom_fonction, ">>");
2351:
2352: (*l_element_courant).suivant = NULL;
2353: s_objet_argument = NULL;
2354: }
2355:
2356: /*
2357: --------------------------------------------------------------------------------
2358: Plancher d'une expression
2359: --------------------------------------------------------------------------------
2360: */
2361:
2362: else if (((*s_objet_argument).type == ALG) ||
2363: ((*s_objet_argument).type == RPN))
2364: {
2365: if ((s_copie_argument = copie_objet(s_etat_processus,
2366: s_objet_argument, 'N')) == NULL)
2367: {
2368: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2369: return;
2370: }
2371:
2372: l_element_courant = (struct_liste_chainee *)
2373: (*s_copie_argument).objet;
2374: l_element_precedent = l_element_courant;
2375:
2376: while((*l_element_courant).suivant != NULL)
2377: {
2378: l_element_precedent = l_element_courant;
2379: l_element_courant = (*l_element_courant).suivant;
2380: }
2381:
2382: if (((*l_element_precedent).suivant =
2383: allocation_maillon(s_etat_processus)) == NULL)
2384: {
2385: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2386: return;
2387: }
2388:
2389: if (((*(*l_element_precedent).suivant).donnee =
2390: allocation(s_etat_processus, FCT)) == NULL)
2391: {
2392: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2393: return;
2394: }
2395:
2396: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2397: .donnee).objet)).nombre_arguments = 1;
2398: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2399: .donnee).objet)).fonction = instruction_floor;
2400:
2401: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2402: .suivant).donnee).objet)).nom_fonction =
2403: malloc(6 * sizeof(unsigned char))) == NULL)
2404: {
2405: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2406: return;
2407: }
2408:
2409: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2410: .suivant).donnee).objet)).nom_fonction, "FLOOR");
2411:
2412: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2413:
2414: s_objet_resultat = s_copie_argument;
2415: }
2416:
2417: /*
2418: --------------------------------------------------------------------------------
2419: Fonction floor impossible à réaliser
2420: --------------------------------------------------------------------------------
2421: */
2422:
2423: else
2424: {
2425: liberation(s_etat_processus, s_objet_argument);
2426:
2427: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2428: return;
2429: }
2430:
2431: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2432: s_objet_resultat) == d_erreur)
2433: {
2434: return;
2435: }
2436:
2437: liberation(s_etat_processus, s_objet_argument);
2438:
2439: return;
2440: }
2441:
2442:
2443: /*
2444: ================================================================================
2445: Fonction 'fp'
2446: ================================================================================
2447: Entrées :
2448: --------------------------------------------------------------------------------
2449: Sorties :
2450: --------------------------------------------------------------------------------
2451: Effets de bord : néant
2452: ================================================================================
2453: */
2454:
2455: void
2456: instruction_fp(struct_processus *s_etat_processus)
2457: {
2458: struct_liste_chainee *l_element_courant;
2459: struct_liste_chainee *l_element_precedent;
2460:
2461: struct_objet *s_copie_argument;
2462: struct_objet *s_objet_argument;
2463: struct_objet *s_objet_resultat;
2464:
2465: (*s_etat_processus).erreur_execution = d_ex;
2466:
2467: if ((*s_etat_processus).affichage_arguments == 'Y')
2468: {
2469: printf("\n FP ");
2470:
2471: if ((*s_etat_processus).langue == 'F')
2472: {
2473: printf("(part fractionnaire)\n\n");
2474: }
2475: else
2476: {
2477: printf("(fractional part)\n\n");
2478: }
2479:
2480: printf(" 1: %s, %s\n", d_INT, d_REL);
2481: printf("-> 1: %s\n\n", d_REL);
2482:
2483: printf(" 1: %s, %s\n", d_NOM, d_ALG);
2484: printf("-> 1: %s\n\n", d_ALG);
2485:
2486: printf(" 1: %s\n", d_RPN);
2487: printf("-> 1: %s\n", d_RPN);
2488:
2489: return;
2490: }
2491: else if ((*s_etat_processus).test_instruction == 'Y')
2492: {
2493: (*s_etat_processus).nombre_arguments = 1;
2494: return;
2495: }
2496:
2497: if (test_cfsf(s_etat_processus, 31) == d_vrai)
2498: {
2499: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
2500: {
2501: return;
2502: }
2503: }
2504:
2505: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2506: &s_objet_argument) == d_erreur)
2507: {
2508: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2509: return;
2510: }
2511:
2512: /*
2513: --------------------------------------------------------------------------------
2514: fp d'un entier
2515: --------------------------------------------------------------------------------
2516: */
2517:
2518: if ((*s_objet_argument).type == INT)
2519: {
2520: if ((s_objet_resultat = allocation(s_etat_processus, REL))
2521: == NULL)
2522: {
2523: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2524: return;
2525: }
2526:
2527: (*((real8 *) (*s_objet_resultat).objet)) = 0;
2528: }
2529:
2530: /*
2531: --------------------------------------------------------------------------------
2532: fp d'un réel
2533: --------------------------------------------------------------------------------
2534: */
2535:
2536: else if ((*s_objet_argument).type == REL)
2537: {
2538: if ((s_objet_resultat = allocation(s_etat_processus, REL))
2539: == NULL)
2540: {
2541: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2542: return;
2543: }
2544:
2545: if ((*((real8 *) (*s_objet_argument).objet)) > 0)
2546: {
2547: (*((real8 *) (*s_objet_resultat).objet)) =
2548: (*((real8 *) (*s_objet_argument).objet)) -
2549: floor((*((real8 *) (*s_objet_argument).objet)));
2550: }
2551: else
2552: {
2553: (*((real8 *) (*s_objet_resultat).objet)) =
2554: (*((real8 *) (*s_objet_argument).objet)) -
2555: ceil((*((real8 *) (*s_objet_argument).objet)));
2556: }
2557: }
2558:
2559: /*
2560: --------------------------------------------------------------------------------
2561: fp d'un nom
2562: --------------------------------------------------------------------------------
2563: */
2564:
2565: else if ((*s_objet_argument).type == NOM)
2566: {
2567: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
2568: == NULL)
2569: {
2570: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2571: return;
2572: }
2573:
2574: if (((*s_objet_resultat).objet =
2575: allocation_maillon(s_etat_processus)) == NULL)
2576: {
2577: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2578: return;
2579: }
2580:
2581: l_element_courant = (*s_objet_resultat).objet;
2582:
2583: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2584: == NULL)
2585: {
2586: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2587: return;
2588: }
2589:
2590: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2591: .nombre_arguments = 0;
2592: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2593: .fonction = instruction_vers_niveau_superieur;
2594:
2595: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2596: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2597: {
2598: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2599: return;
2600: }
2601:
2602: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2603: .nom_fonction, "<<");
2604:
2605: if (((*l_element_courant).suivant =
2606: allocation_maillon(s_etat_processus)) == NULL)
2607: {
2608: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2609: return;
2610: }
2611:
2612: l_element_courant = (*l_element_courant).suivant;
2613: (*l_element_courant).donnee = s_objet_argument;
2614:
2615: if (((*l_element_courant).suivant =
2616: allocation_maillon(s_etat_processus)) == NULL)
2617: {
2618: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2619: return;
2620: }
2621:
2622: l_element_courant = (*l_element_courant).suivant;
2623:
2624: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2625: == NULL)
2626: {
2627: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2628: return;
2629: }
2630:
2631: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2632: .nombre_arguments = 1;
2633: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2634: .fonction = instruction_fp;
2635:
2636: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2637: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2638: {
2639: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2640: return;
2641: }
2642:
2643: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2644: .nom_fonction, "FP");
2645:
2646: if (((*l_element_courant).suivant =
2647: allocation_maillon(s_etat_processus)) == NULL)
2648: {
2649: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2650: return;
2651: }
2652:
2653: l_element_courant = (*l_element_courant).suivant;
2654:
2655: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2656: == NULL)
2657: {
2658: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2659: return;
2660: }
2661:
2662: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2663: .nombre_arguments = 0;
2664: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2665: .fonction = instruction_vers_niveau_inferieur;
2666:
2667: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2668: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2669: {
2670: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2671: return;
2672: }
2673:
2674: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2675: .nom_fonction, ">>");
2676:
2677: (*l_element_courant).suivant = NULL;
2678: s_objet_argument = NULL;
2679: }
2680:
2681: /*
2682: --------------------------------------------------------------------------------
2683: fp d'une expression
2684: --------------------------------------------------------------------------------
2685: */
2686:
2687: else if (((*s_objet_argument).type == ALG) ||
2688: ((*s_objet_argument).type == RPN))
2689: {
2690: if ((s_copie_argument = copie_objet(s_etat_processus,
2691: s_objet_argument, 'N')) == NULL)
2692: {
2693: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2694: return;
2695: }
2696:
2697: l_element_courant = (struct_liste_chainee *)
2698: (*s_copie_argument).objet;
2699: l_element_precedent = l_element_courant;
2700:
2701: while((*l_element_courant).suivant != NULL)
2702: {
2703: l_element_precedent = l_element_courant;
2704: l_element_courant = (*l_element_courant).suivant;
2705: }
2706:
2707: if (((*l_element_precedent).suivant =
2708: allocation_maillon(s_etat_processus)) == NULL)
2709: {
2710: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2711: return;
2712: }
2713:
2714: if (((*(*l_element_precedent).suivant).donnee =
2715: allocation(s_etat_processus, FCT)) == NULL)
2716: {
2717: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2718: return;
2719: }
2720:
2721: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2722: .donnee).objet)).nombre_arguments = 1;
2723: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2724: .donnee).objet)).fonction = instruction_fp;
2725:
2726: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2727: .suivant).donnee).objet)).nom_fonction =
2728: malloc(3 * sizeof(unsigned char))) == NULL)
2729: {
2730: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2731: return;
2732: }
2733:
2734: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2735: .suivant).donnee).objet)).nom_fonction, "FP");
2736:
2737: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2738:
2739: s_objet_resultat = s_copie_argument;
2740: }
2741:
2742: /*
2743: --------------------------------------------------------------------------------
2744: Fonction fp impossible à réaliser
2745: --------------------------------------------------------------------------------
2746: */
2747:
2748: else
2749: {
2750: liberation(s_etat_processus, s_objet_argument);
2751:
2752: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2753: return;
2754: }
2755:
2756: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2757: s_objet_resultat) == d_erreur)
2758: {
2759: return;
2760: }
2761:
2762: liberation(s_etat_processus, s_objet_argument);
2763:
2764: return;
2765: }
2766:
2767:
2768: /*
2769: ================================================================================
2770: Fonction 'fix'
2771: ================================================================================
2772: Entrées : pointeur sur une struct_processus
2773: --------------------------------------------------------------------------------
2774: Sorties :
2775: --------------------------------------------------------------------------------
2776: Effets de bord : néant
2777: ================================================================================
2778: */
2779:
2780: void
2781: instruction_fix(struct_processus *s_etat_processus)
2782: {
2783: struct_objet *s_objet_argument;
2784: struct_objet *s_objet;
2785:
2786: logical1 i43;
2787: logical1 i44;
2788:
2789: unsigned char *valeur_binaire;
2790:
2791: unsigned long i;
2792: unsigned long j;
2793:
2794: (*s_etat_processus).erreur_execution = d_ex;
2795:
2796: if ((*s_etat_processus).affichage_arguments == 'Y')
2797: {
2798: printf("\n FIX ");
2799:
2800: if ((*s_etat_processus).langue == 'F')
2801: {
2802: printf("(format virgule fixe)\n\n");
2803: }
2804: else
2805: {
2806: printf("(fixed point format)\n\n");
2807: }
2808:
2809: printf(" 1: %s\n", d_INT);
2810:
2811: return;
2812: }
2813: else if ((*s_etat_processus).test_instruction == 'Y')
2814: {
2815: (*s_etat_processus).nombre_arguments = -1;
2816: return;
2817: }
2818:
2819: if (test_cfsf(s_etat_processus, 31) == d_vrai)
2820: {
2821: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
2822: {
2823: return;
2824: }
2825: }
2826:
2827: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2828: &s_objet_argument) == d_erreur)
2829: {
2830: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2831: return;
2832: }
2833:
2834: if ((*s_objet_argument).type == INT)
2835: {
2836: if (((*((integer8 *) (*s_objet_argument).objet)) >= 0) &&
2837: ((*((integer8 *) (*s_objet_argument).objet)) <= 15))
2838: {
2839: if ((s_objet = allocation(s_etat_processus, BIN)) == NULL)
2840: {
2841: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2842: return;
2843: }
2844:
1.53 bertrand 2845: (*((logical8 *) (*s_objet).objet)) = (logical8)
1.1 bertrand 2846: (*((integer8 *) (*s_objet_argument).objet));
2847:
2848: i43 = test_cfsf(s_etat_processus, 43);
2849: i44 = test_cfsf(s_etat_processus, 44);
2850:
2851: sf(s_etat_processus, 44);
2852: cf(s_etat_processus, 43);
2853:
2854: if ((valeur_binaire = formateur(s_etat_processus, 0, s_objet))
2855: == NULL)
2856: {
2857: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2858: return;
2859: }
2860:
2861: if (i43 == d_vrai)
2862: {
2863: sf(s_etat_processus, 43);
2864: }
2865: else
2866: {
2867: cf(s_etat_processus, 43);
2868: }
2869:
2870: if (i44 == d_vrai)
2871: {
2872: sf(s_etat_processus, 44);
2873: }
2874: else
2875: {
2876: cf(s_etat_processus, 44);
2877: }
2878:
2879: for(j = 53, i = strlen(valeur_binaire) - 2; i >= 2; i--)
2880: {
2881: if (valeur_binaire[i] == '0')
2882: {
1.53 bertrand 2883: cf(s_etat_processus, (unsigned char) j++);
1.1 bertrand 2884: }
2885: else
2886: {
1.53 bertrand 2887: sf(s_etat_processus, (unsigned char) j++);
1.1 bertrand 2888: }
2889: }
2890:
1.53 bertrand 2891: for(; j <= 56; cf(s_etat_processus, (unsigned char) j++));
1.1 bertrand 2892:
2893: sf(s_etat_processus, 49);
2894: cf(s_etat_processus, 50);
2895:
2896: free(valeur_binaire);
2897: liberation(s_etat_processus, s_objet);
2898: }
2899: else
2900: {
2901: liberation(s_etat_processus, s_objet_argument);
2902:
2903: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
2904: return;
2905: }
2906: }
2907: else
2908: {
2909: liberation(s_etat_processus, s_objet_argument);
2910:
2911: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2912: return;
2913: }
2914:
2915: liberation(s_etat_processus, s_objet_argument);
2916:
2917: return;
2918: }
2919:
2920: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_f1.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src