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