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