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