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