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