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