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