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