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