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