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