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