1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.27
4: Copyright (C) 1989-2017 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: Affectation automatique d'un type à des données
29: ================================================================================
30: Entrées : structure sur l'état du processus
31: --------------------------------------------------------------------------------
32: Sorties : Néant
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: recherche_type(struct_processus *s_etat_processus)
40: {
41: integer8 i;
42: integer8 j;
43: integer8 niveau;
44: integer8 niveau_maximal;
45: integer8 nombre_colonnes;
46: integer8 nombre_egalites;
47: integer8 nombre_elements;
48: integer8 nombre_elements_convertis;
49: integer8 nombre_exposants;
50: integer8 nombre_lignes;
51: integer8 nombre_lignes_a_supprimer;
52: integer8 nombre_points;
53: integer8 nombre_virgules;
54: integer8 position_courante;
55: integer8 profondeur_finale;
56: integer8 profondeur_initiale;
57: integer8 sauvegarde_niveau_courant;
58: integer8 sauvegarde_longueur_definitions_chainees;
59: integer8 (*__type_new)(struct_processus *, void **);
60:
61: struct_liste_chainee *l_base_liste_fonctions;
62: struct_liste_chainee *l_base_liste_decomposition;
63: struct_liste_chainee *l_element_courant;
64: struct_liste_chainee *l_element_courant_fonctions;
65: struct_liste_chainee *l_element_precedent;
66:
67: struct_liste_pile_systeme *s_sauvegarde_pile;
68:
69: struct_objet *s_objet;
70: struct_objet *s_objet_registre;
71: struct_objet *s_sous_objet;
72:
73: logical1 drapeau_chaine;
74: logical1 drapeau_complexe;
75: logical1 drapeau_matrice;
76: logical1 drapeau_reel;
77: logical1 drapeau_valeur_entiere;
78: logical1 drapeau_valeur_reelle;
79: logical1 erreur;
80: logical1 erreur_lecture_binaire;
81:
82: logical8 ancienne_valeur_base;
83: logical8 valeur_base;
84:
85: long coherence_liste;
86:
87: unsigned char autorisation_evaluation_nom;
88: unsigned char *definitions_chainees_precedentes;
89: unsigned char *fonction_majuscule;
90: unsigned char *instruction_majuscule;
91: unsigned char *ptr;
92: unsigned char *ptr_ecriture;
93: unsigned char *ptr_lecture;
94: unsigned char registre_instruction_valide;
95: unsigned char registre_interruption;
96: unsigned char registre_mode_execution_programme;
97: unsigned char registre_recherche_type;
98: unsigned char registre_test;
99: unsigned char registre_test_bis;
100: unsigned char *tampon;
101: unsigned char variable_implicite;
102:
103: void *element;
104:
105: if ((s_objet = allocation(s_etat_processus, NON)) == NULL)
106: {
107: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
108: return;
109: }
110:
111: element = NULL;
112: nombre_egalites = 0;
113: i = 0;
114:
115: registre_test = (*s_etat_processus).test_instruction;
116: registre_instruction_valide = (*s_etat_processus).instruction_valide;
117: registre_interruption = (*s_etat_processus).traitement_interruptible;
118: (*s_etat_processus).test_instruction = 'Y';
119: (*s_etat_processus).traitement_interruptible = 'N';
120:
121: analyse(s_etat_processus, NULL);
122:
123: (*s_etat_processus).test_instruction = registre_test;
124:
125: if ((*s_etat_processus).instruction_valide == 'Y')
126: {
127: if ((*s_etat_processus).constante_symbolique == 'N')
128: {
129: if ((element = malloc(sizeof(struct_fonction))) == NULL)
130: {
131: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
132: (*s_etat_processus).traitement_interruptible =
133: registre_interruption;
134: return;
135: }
136:
137: (*((struct_fonction *) element)).nombre_arguments = 0;
138: (*((struct_fonction *) element)).prediction_saut = NULL;
139:
140: if ((*s_etat_processus).instruction_intrinseque == 'Y')
141: {
142: /*
143: * Les fonctions intrinsèques ne sont pas sensibles à la casse.
144: */
145:
146: if (((*((struct_fonction *) element)).nom_fonction =
147: conversion_majuscule(s_etat_processus,
148: (*s_etat_processus).instruction_courante)) == NULL)
149: {
150: (*s_etat_processus).erreur_systeme =
151: d_es_allocation_memoire;
152: (*s_etat_processus).traitement_interruptible =
153: registre_interruption;
154: return;
155: }
156: }
157: else
158: {
159: if (((*((struct_fonction *) element)).nom_fonction =
160: malloc((strlen((*s_etat_processus).instruction_courante)
161: + 1) * sizeof(unsigned char))) == NULL)
162: {
163: (*s_etat_processus).erreur_systeme =
164: d_es_allocation_memoire;
165: (*s_etat_processus).traitement_interruptible =
166: registre_interruption;
167: return;
168: }
169:
170: strcpy((*((struct_fonction *) element)).nom_fonction,
171: (*s_etat_processus).instruction_courante);
172: }
173:
174: (*((struct_fonction *) element)).fonction =
175: analyse_instruction(s_etat_processus,
176: (*((struct_fonction *) element)).nom_fonction);
177:
178: (*s_objet).type = FCT;
179: (*s_objet).objet = element;
180: (*((struct_fonction *) (*s_objet).objet)).prediction_saut = NULL;
181: (*((struct_fonction *) (*s_objet).objet)).prediction_execution
182: = d_faux;
183:
184: if (empilement(s_etat_processus,
185: &((*s_etat_processus).l_base_pile), s_objet) == d_erreur)
186: {
187: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
188: (*s_etat_processus).traitement_interruptible =
189: registre_interruption;
190: return;
191: }
192: }
193: else
194: {
195: if ((instruction_majuscule = conversion_majuscule(s_etat_processus,
196: (*s_etat_processus).instruction_courante)) == NULL)
197: {
198: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
199: (*s_etat_processus).traitement_interruptible =
200: registre_interruption;
201: return;
202: }
203:
204: if ((*s_etat_processus).constante_symbolique == 'Y')
205: {
206: registre_test_bis = (*s_etat_processus).test_instruction;
207: (*s_etat_processus).test_instruction = 'N';
208: analyse(s_etat_processus, NULL);
209: (*s_etat_processus).test_instruction = registre_test_bis;
210: liberation(s_etat_processus, s_objet);
211: }
212: else
213: {
214: (*s_objet).type = NOM;
215:
216: if (((*s_objet).objet = malloc(sizeof(struct_nom))) == NULL)
217: {
218: (*s_etat_processus).erreur_systeme =
219: d_es_allocation_memoire;
220: (*s_etat_processus).traitement_interruptible =
221: registre_interruption;
222: return;
223: }
224:
225: (*((struct_nom *) (*s_objet).objet)).symbole = d_faux;
226:
227: if (((*((struct_nom *) (*s_objet).objet)).nom =
228: (unsigned char *) malloc((strlen((*s_etat_processus)
229: .instruction_courante) + 1) * sizeof(unsigned char)))
230: == NULL)
231: {
232: (*s_etat_processus).erreur_systeme =
233: d_es_allocation_memoire;
234: (*s_etat_processus).traitement_interruptible =
235: registre_interruption;
236: return;
237: }
238:
239: strcpy((*((struct_nom *) (*s_objet).objet)).nom,
240: (*s_etat_processus).instruction_courante);
241:
242: if (empilement(s_etat_processus,
243: &((*s_etat_processus).l_base_pile), s_objet) ==
244: d_erreur)
245: {
246: (*s_etat_processus).erreur_systeme =
247: d_es_allocation_memoire;
248: (*s_etat_processus).traitement_interruptible =
249: registre_interruption;
250: return;
251: }
252: }
253:
254: free(instruction_majuscule);
255: }
256:
257: (*s_etat_processus).instruction_valide = registre_instruction_valide;
258: (*s_etat_processus).traitement_interruptible = registre_interruption;
259: return;
260: }
261:
262: (*s_etat_processus).instruction_valide = registre_instruction_valide;
263:
264: /*
265: --------------------------------------------------------------------------------
266: Types externes
267: --------------------------------------------------------------------------------
268: */
269:
270: l_element_courant = (*s_etat_processus).s_bibliotheques;
271:
272: while(l_element_courant != NULL)
273: {
274: if ((__type_new = dlsym((*((struct_bibliotheque *)
275: (*l_element_courant).donnee)).descripteur, "__type_new"))
276: != NULL)
277: {
278: if (((*s_objet).extension_type = __type_new(s_etat_processus,
279: &element)) != 0)
280: {
281: // Le type peut être converti.
282:
283: (*s_objet).objet = element;
284: (*s_objet).type = EXT;
285: (*s_objet).descripteur_bibliotheque =
286: (*((struct_bibliotheque *)
287: (*l_element_courant).donnee)).descripteur;
288:
289: if (empilement(s_etat_processus,
290: &((*s_etat_processus).l_base_pile), s_objet)
291: == d_erreur)
292: {
293: (*s_etat_processus).erreur_systeme =
294: d_es_allocation_memoire;
295: (*s_etat_processus).traitement_interruptible =
296: registre_interruption;
297: return;
298: }
299:
300: (*s_etat_processus).traitement_interruptible =
301: registre_interruption;
302: return;
303: }
304: }
305:
306: l_element_courant = (*l_element_courant).suivant;
307: }
308:
309: /*
310: --------------------------------------------------------------------------------
311: Types internes
312: --------------------------------------------------------------------------------
313: */
314:
315: switch(*((*s_etat_processus).instruction_courante))
316: {
317:
318: /*
319: --------------------------------------------------------------------------------
320: Complexe
321: --------------------------------------------------------------------------------
322: */
323:
324: case '(' :
325: {
326: element = (void *) ((struct_complexe16 *) malloc(
327: sizeof(struct_complexe16)));
328:
329: if (element == NULL)
330: {
331: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
332: (*s_etat_processus).traitement_interruptible =
333: registre_interruption;
334: return;
335: }
336:
337: conversion_format(s_etat_processus,
338: (*s_etat_processus).instruction_courante);
339:
340: sauvegarde_longueur_definitions_chainees =
341: (*s_etat_processus).longueur_definitions_chainees;
342:
343: tampon = (unsigned char *) malloc(((size_t)
344: (((*s_etat_processus).longueur_definitions_chainees
345: = (integer8) strlen((*s_etat_processus)
346: .instruction_courante) + 4) + 1)) * sizeof(unsigned char));
347:
348: if (tampon == NULL)
349: {
350: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
351: (*s_etat_processus).traitement_interruptible =
352: registre_interruption;
353: return;
354: }
355:
356: strcpy(tampon, "<< ");
357: ptr_ecriture = tampon + 3;
358: ptr_lecture = (*s_etat_processus).instruction_courante + 1;
359:
360: nombre_virgules = 0;
361:
362: while((*ptr_lecture) != d_code_fin_chaine)
363: {
364: if ((*ptr_lecture) == ',')
365: {
366: (*ptr_lecture) = ' ';
367: nombre_virgules++;
368: }
369:
370: *ptr_ecriture++ = *ptr_lecture++;
371: }
372:
373: (*(--ptr_ecriture)) = d_code_fin_chaine;
374: strcat(ptr_ecriture, " >>");
375:
376: position_courante = (*s_etat_processus).position_courante;
377: (*s_etat_processus).position_courante = 0;
378:
379: profondeur_initiale = (*s_etat_processus)
380: .hauteur_pile_operationnelle;
381:
382: /*
383: -- On met le tout dans la pile opérationnelle ----------------------------------
384: */
385:
386: (*s_etat_processus).niveau_recursivite++;
387: definitions_chainees_precedentes = (*s_etat_processus)
388: .definitions_chainees;
389: (*s_etat_processus).definitions_chainees = tampon;
390:
391: s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
392: sauvegarde_niveau_courant = (*s_etat_processus).niveau_courant;
393:
394: (*s_etat_processus).l_base_pile_systeme = NULL;
395: empilement_pile_systeme(s_etat_processus);
396:
397: if ((*s_etat_processus).erreur_systeme != d_es)
398: {
399: (*s_etat_processus).traitement_interruptible =
400: registre_interruption;
401: return;
402: }
403:
404: (*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'Y';
405: (*s_etat_processus).niveau_courant = 0;
406: (*s_etat_processus).autorisation_empilement_programme = 'N';
407: registre_mode_execution_programme =
408: (*s_etat_processus).mode_execution_programme;
409: (*s_etat_processus).mode_execution_programme = 'Y';
410:
411: tampon = (*s_etat_processus).instruction_courante;
412:
413: if ((*s_etat_processus).profilage == d_vrai)
414: {
415: profilage(s_etat_processus, "RPL/2 internals");
416:
417: if ((*s_etat_processus).erreur_systeme != d_es)
418: {
419: return;
420: }
421: }
422:
423: registre_recherche_type = (*s_etat_processus).recherche_type;
424: (*s_etat_processus).recherche_type = 'Y';
425:
426: if (sequenceur(s_etat_processus) == d_erreur)
427: {
428: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
429: (*s_etat_processus).recherche_type = registre_recherche_type;
430: (*s_etat_processus).instruction_courante = tampon;
431: (*s_etat_processus).mode_execution_programme =
432: registre_mode_execution_programme;
433:
434: effacement_pile_systeme(s_etat_processus);
435: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
436: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
437:
438: (*s_etat_processus).niveau_recursivite--;
439:
440: (*s_etat_processus).position_courante = position_courante;
441: free((*s_etat_processus).definitions_chainees);
442: (*s_etat_processus).definitions_chainees =
443: definitions_chainees_precedentes;
444: (*s_etat_processus).longueur_definitions_chainees =
445: sauvegarde_longueur_definitions_chainees;
446:
447: free(element);
448: liberation(s_etat_processus, s_objet);
449:
450: (*s_etat_processus).traitement_interruptible =
451: registre_interruption;
452: return;
453: }
454:
455: (*s_etat_processus).recherche_type = registre_recherche_type;
456: (*s_etat_processus).instruction_courante = tampon;
457: (*s_etat_processus).mode_execution_programme =
458: registre_mode_execution_programme;
459:
460: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
461: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
462:
463: (*s_etat_processus).niveau_recursivite--;
464:
465: (*s_etat_processus).position_courante = position_courante;
466: free((*s_etat_processus).definitions_chainees);
467: (*s_etat_processus).definitions_chainees =
468: definitions_chainees_precedentes;
469: (*s_etat_processus).longueur_definitions_chainees =
470: sauvegarde_longueur_definitions_chainees;
471:
472: /*
473: -- On relit la pile pour remplir le complexe -----------------------------------
474: */
475:
476: profondeur_finale = (*s_etat_processus).hauteur_pile_operationnelle;
477: nombre_elements_convertis = profondeur_finale - profondeur_initiale;
478:
479: if ((nombre_elements_convertis != 2) || (nombre_virgules != 1))
480: {
481: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
482:
483: liberation(s_etat_processus, s_objet);
484: free(element);
485:
486: for(i = 0; i < nombre_elements_convertis; i++)
487: {
488: if (depilement(s_etat_processus, &((*s_etat_processus)
489: .l_base_pile), &s_sous_objet) == d_erreur)
490: {
491: (*s_etat_processus).traitement_interruptible =
492: registre_interruption;
493: return;
494: }
495:
496: liberation(s_etat_processus, s_sous_objet);
497: }
498:
499: (*s_etat_processus).traitement_interruptible =
500: registre_interruption;
501: return;
502: }
503: else
504: {
505: if (depilement(s_etat_processus,
506: &((*s_etat_processus).l_base_pile), &s_sous_objet) ==
507: d_absence_erreur)
508: {
509: if ((*s_sous_objet).type == INT)
510: {
511: (*((struct_complexe16 *) element)).partie_imaginaire =
512: (real8) (*((integer8 *) (*s_sous_objet).objet));
513: }
514: else if ((*s_sous_objet).type == REL)
515: {
516: (*((struct_complexe16 *) element)).partie_imaginaire =
517: (*((real8 *) (*s_sous_objet).objet));
518: }
519: else
520: {
521: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
522:
523: free(element);
524: liberation(s_etat_processus, s_objet);
525:
526: liberation(s_etat_processus, s_sous_objet);
527:
528: (*s_etat_processus).traitement_interruptible =
529: registre_interruption;
530: return;
531: }
532:
533: liberation(s_etat_processus, s_sous_objet);
534:
535: if (depilement(s_etat_processus,
536: &((*s_etat_processus).l_base_pile), &s_sous_objet)
537: == d_absence_erreur)
538: {
539: if ((*s_sous_objet).type == INT)
540: {
541: (*((struct_complexe16 *) element)).partie_reelle =
542: (real8) (*((integer8 *)
543: (*s_sous_objet).objet));
544: }
545: else if ((*s_sous_objet).type == REL)
546: {
547: (*((struct_complexe16 *) element)).partie_reelle =
548: (*((real8 *) (*s_sous_objet).objet));
549: }
550: else
551: {
552: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
553:
554: free(element);
555: liberation(s_etat_processus, s_objet);
556:
557: liberation(s_etat_processus, s_sous_objet);
558:
559: (*s_etat_processus).traitement_interruptible =
560: registre_interruption;
561: return;
562: }
563:
564: liberation(s_etat_processus, s_sous_objet);
565: }
566: }
567: }
568:
569: (*s_objet).type = CPL;
570: break;
571: }
572:
573: /*
574: --------------------------------------------------------------------------------
575: Binaire
576: --------------------------------------------------------------------------------
577: */
578:
579: case '#' :
580: {
581: element = (void *) ((logical8 *) malloc(
582: sizeof(logical8)));
583:
584: if (element == NULL)
585: {
586: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
587: (*s_etat_processus).traitement_interruptible =
588: registre_interruption;
589: return;
590: }
591:
592: erreur_lecture_binaire = d_faux;
593:
594: switch((*s_etat_processus).instruction_courante
595: [strlen((*s_etat_processus).instruction_courante) - 1])
596: {
597: case 'b' :
598: {
599: i = ((integer8) strlen((*s_etat_processus)
600: .instruction_courante)) - 2;
601: valeur_base = 1;
602:
603: (*((logical8 *) element)) = 0;
604:
605: while(i > 0)
606: {
607: if ((*s_etat_processus).instruction_courante[i] == '1')
608: {
609: (*((logical8 *) element)) += valeur_base;
610: }
611: else if ((*s_etat_processus).instruction_courante[i]
612: != '0')
613: {
614: if ((*s_etat_processus).instruction_courante[i]
615: == ' ')
616: {
617: while(i > 0)
618: {
619: if ((*s_etat_processus)
620: .instruction_courante[i] != ' ')
621: {
622: break;
623: }
624:
625: i--;
626: }
627: }
628:
629: if (i != 0)
630: {
631: free(element);
632: liberation(s_etat_processus, s_objet);
633:
634: (*s_etat_processus).erreur_execution =
635: d_ex_syntaxe;
636: (*s_etat_processus).traitement_interruptible =
637: registre_interruption;
638: return;
639: }
640:
641: break;
642: }
643:
644: ancienne_valeur_base = valeur_base;
645: valeur_base *= 2;
646:
647: if (ancienne_valeur_base > valeur_base)
648: {
649: i--;
650:
651: while(i > 0)
652: {
653: if ((*s_etat_processus).instruction_courante[i]
654: != ' ')
655: {
656: erreur_lecture_binaire = d_vrai;
657: }
658:
659: i--;
660: }
661:
662: break;
663: }
664:
665: i--;
666: }
667:
668: nombre_elements_convertis = 1;
669: break;
670: }
671:
672: case 'o' :
673: {
674: i = ((integer8) strlen((*s_etat_processus)
675: .instruction_courante)) - 2;
676: valeur_base = 1;
677:
678: (*((logical8 *) element)) = 0;
679:
680: while(i > 0)
681: {
682: if ((*s_etat_processus).instruction_courante[i] == '1')
683: {
684: (*((logical8 *) element)) += valeur_base;
685: }
686: else if ((*s_etat_processus).instruction_courante[i]
687: == '2')
688: {
689: (*((logical8 *) element)) += 2 * valeur_base;
690: }
691: else if ((*s_etat_processus).instruction_courante[i]
692: == '3')
693: {
694: (*((logical8 *) element)) += 3 * valeur_base;
695: }
696: else if ((*s_etat_processus).instruction_courante[i]
697: == '4')
698: {
699: (*((logical8 *) element)) += 4 * valeur_base;
700: }
701: else if ((*s_etat_processus).instruction_courante[i]
702: == '5')
703: {
704: (*((logical8 *) element)) += 5 * valeur_base;
705: }
706: else if ((*s_etat_processus).instruction_courante[i]
707: == '6')
708: {
709: (*((logical8 *) element)) += 6 * valeur_base;
710: }
711: else if ((*s_etat_processus).instruction_courante[i]
712: == '7')
713: {
714: (*((logical8 *) element)) += 7 * valeur_base;
715: }
716: else if ((*s_etat_processus).instruction_courante[i]
717: != '0')
718: {
719: if ((*s_etat_processus).instruction_courante[i]
720: == ' ')
721: {
722: while(i > 0)
723: {
724: if ((*s_etat_processus)
725: .instruction_courante[i] != ' ')
726: {
727: break;
728: }
729:
730: i--;
731: }
732: }
733:
734: if (i != 0)
735: {
736: free(element);
737: liberation(s_etat_processus, s_objet);
738:
739: (*s_etat_processus).erreur_execution =
740: d_ex_syntaxe;
741: (*s_etat_processus).traitement_interruptible =
742: registre_interruption;
743: return;
744: }
745:
746: break;
747: }
748:
749: ancienne_valeur_base = valeur_base;
750: valeur_base *= 8;
751:
752: if (ancienne_valeur_base > valeur_base)
753: {
754: i--;
755:
756: while(i > 0)
757: {
758: if ((*s_etat_processus).instruction_courante[i]
759: != ' ')
760: {
761: erreur_lecture_binaire = d_vrai;
762: }
763:
764: i--;
765: }
766:
767: break;
768: }
769:
770: i--;
771: }
772:
773: nombre_elements_convertis = 1;
774: break;
775: }
776:
777: case 'd' :
778: {
779: i = ((integer8) strlen((*s_etat_processus)
780: .instruction_courante)) - 2;
781: valeur_base = 1;
782:
783: (*((logical8 *) element)) = 0;
784:
785: while(i > 0)
786: {
787: if ((*s_etat_processus).instruction_courante[i] == '1')
788: {
789: (*((logical8 *) element)) += valeur_base;
790: }
791: else if ((*s_etat_processus).instruction_courante[i]
792: == '2')
793: {
794: (*((logical8 *) element)) += 2 * valeur_base;
795: }
796: else if ((*s_etat_processus).instruction_courante[i]
797: == '3')
798: {
799: (*((logical8 *) element)) += 3 * valeur_base;
800: }
801: else if ((*s_etat_processus).instruction_courante[i]
802: == '4')
803: {
804: (*((logical8 *) element)) += 4 * valeur_base;
805: }
806: else if ((*s_etat_processus).instruction_courante[i]
807: == '5')
808: {
809: (*((logical8 *) element)) += 5 * valeur_base;
810: }
811: else if ((*s_etat_processus).instruction_courante[i]
812: == '6')
813: {
814: (*((logical8 *) element)) += 6 * valeur_base;
815: }
816: else if ((*s_etat_processus).instruction_courante[i]
817: == '7')
818: {
819: (*((logical8 *) element)) += 7 * valeur_base;
820: }
821: else if ((*s_etat_processus).instruction_courante[i]
822: == '8')
823: {
824: (*((logical8 *) element)) += 8 * valeur_base;
825: }
826: else if ((*s_etat_processus).instruction_courante[i]
827: == '9')
828: {
829: (*((logical8 *) element)) += 9 * valeur_base;
830: }
831: else if ((*s_etat_processus).instruction_courante[i]
832: != '0')
833: {
834: if ((*s_etat_processus).instruction_courante[i]
835: == ' ')
836: {
837: while(i > 0)
838: {
839: if ((*s_etat_processus)
840: .instruction_courante[i] != ' ')
841: {
842: break;
843: }
844:
845: i--;
846: }
847: }
848:
849: if (i != 0)
850: {
851: free(element);
852: liberation(s_etat_processus, s_objet);
853:
854: (*s_etat_processus).erreur_execution =
855: d_ex_syntaxe;
856: (*s_etat_processus).traitement_interruptible =
857: registre_interruption;
858: return;
859: }
860:
861: break;
862: }
863:
864: ancienne_valeur_base = valeur_base;
865: valeur_base *= 10;
866:
867: if (ancienne_valeur_base > valeur_base)
868: {
869: i--;
870:
871: while(i > 0)
872: {
873: if ((*s_etat_processus).instruction_courante[i]
874: != ' ')
875: {
876: erreur_lecture_binaire = d_vrai;
877: }
878:
879: i--;
880: }
881:
882: break;
883: }
884:
885: i--;
886: }
887:
888: nombre_elements_convertis = 1;
889: break;
890: }
891:
892: case 'h' :
893: {
894: i = ((integer8) strlen((*s_etat_processus)
895: .instruction_courante)) - 2;
896: valeur_base = 1;
897:
898: (*((logical8 *) element)) = 0;
899:
900: while(i > 0)
901: {
902: if ((*s_etat_processus).instruction_courante[i] == '1')
903: {
904: (*((logical8 *) element)) += valeur_base;
905: }
906: else if ((*s_etat_processus).instruction_courante[i]
907: == '2')
908: {
909: (*((logical8 *) element)) += 2 * valeur_base;
910: }
911: else if ((*s_etat_processus).instruction_courante[i]
912: == '3')
913: {
914: (*((logical8 *) element)) += 3 * valeur_base;
915: }
916: else if ((*s_etat_processus).instruction_courante[i]
917: == '4')
918: {
919: (*((logical8 *) element)) += 4 * valeur_base;
920: }
921: else if ((*s_etat_processus).instruction_courante[i]
922: == '5')
923: {
924: (*((logical8 *) element)) += 5 * valeur_base;
925: }
926: else if ((*s_etat_processus).instruction_courante[i]
927: == '6')
928: {
929: (*((logical8 *) element)) += 6 * valeur_base;
930: }
931: else if ((*s_etat_processus).instruction_courante[i]
932: == '7')
933: {
934: (*((logical8 *) element)) += 7 * valeur_base;
935: }
936: else if ((*s_etat_processus).instruction_courante[i]
937: == '8')
938: {
939: (*((logical8 *) element)) += 8 * valeur_base;
940: }
941: else if ((*s_etat_processus).instruction_courante[i]
942: == '9')
943: {
944: (*((logical8 *) element)) += 9 * valeur_base;
945: }
946: else if ((*s_etat_processus).instruction_courante[i]
947: == 'A')
948: {
949: (*((logical8 *) element)) += 10 * valeur_base;
950: }
951: else if ((*s_etat_processus).instruction_courante[i]
952: == 'B')
953: {
954: (*((logical8 *) element)) += 11 * valeur_base;
955: }
956: else if ((*s_etat_processus).instruction_courante[i]
957: == 'C')
958: {
959: (*((logical8 *) element)) += 12 * valeur_base;
960: }
961: else if ((*s_etat_processus).instruction_courante[i]
962: == 'D')
963: {
964: (*((logical8 *) element)) += 13 * valeur_base;
965: }
966: else if ((*s_etat_processus).instruction_courante[i]
967: == 'E')
968: {
969: (*((logical8 *) element)) += 14 * valeur_base;
970: }
971: else if ((*s_etat_processus).instruction_courante[i]
972: == 'F')
973: {
974: (*((logical8 *) element)) += 15 * valeur_base;
975: }
976: else if ((*s_etat_processus).instruction_courante[i]
977: != '0')
978: {
979: if ((*s_etat_processus).instruction_courante[i]
980: == ' ')
981: {
982: while(i > 0)
983: {
984: if ((*s_etat_processus)
985: .instruction_courante[i] != ' ')
986: {
987: break;
988: }
989:
990: i--;
991: }
992: }
993:
994: if (i != 0)
995: {
996: free(element);
997: liberation(s_etat_processus, s_objet);
998:
999: (*s_etat_processus).erreur_execution =
1000: d_ex_syntaxe;
1001: (*s_etat_processus).traitement_interruptible =
1002: registre_interruption;
1003: return;
1004: }
1005:
1006: break;
1007: }
1008:
1009: ancienne_valeur_base = valeur_base;
1010: valeur_base *= 16;
1011:
1012: if (ancienne_valeur_base > valeur_base)
1013: {
1014: i--;
1015:
1016: while(i > 0)
1017: {
1018: if ((*s_etat_processus).instruction_courante[i]
1019: != ' ')
1020: {
1021: erreur_lecture_binaire = d_vrai;
1022: }
1023:
1024: i--;
1025: }
1026:
1027: break;
1028: }
1029:
1030: i--;
1031: }
1032:
1033: nombre_elements_convertis = 1;
1034: break;
1035: }
1036:
1037: default :
1038: {
1039: nombre_elements_convertis = 0;
1040: break;
1041: }
1042: }
1043:
1044: if ((nombre_elements_convertis != 1) ||
1045: (erreur_lecture_binaire == d_vrai))
1046: {
1047: free(element);
1048: liberation(s_etat_processus, s_objet);
1049:
1050: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1051: (*s_etat_processus).traitement_interruptible =
1052: registre_interruption;
1053: return;
1054: }
1055:
1056: (*s_objet).type = BIN;
1057: break;
1058: }
1059:
1060: /*
1061: --------------------------------------------------------------------------------
1062: Matrices ou vecteurs entiers, réels ou complexes
1063: --------------------------------------------------------------------------------
1064: */
1065:
1066: case '[' :
1067: {
1068: niveau = 0;
1069: niveau_maximal = 0;
1070:
1071: nombre_colonnes = 0;
1072: nombre_lignes = 0;
1073:
1074: drapeau_complexe = d_faux;
1075: drapeau_reel = d_faux;
1076:
1077: ptr = (*s_etat_processus).instruction_courante;
1078:
1079: while((*ptr) != d_code_fin_chaine)
1080: {
1081: switch(*ptr)
1082: {
1083: case '(' :
1084: case ')' :
1085: {
1086: drapeau_complexe = d_vrai;
1087: drapeau_reel = d_vrai;
1088: break;
1089: }
1090:
1091: case '.' :
1092: case 'E' :
1093: case 'e' :
1094: {
1095: drapeau_reel = d_vrai;
1096: break;
1097: }
1098:
1099: case '[' :
1100: {
1101: niveau_maximal = (++niveau);
1102: break;
1103: }
1104:
1105: case ']' :
1106: {
1107: niveau--;
1108: break;
1109: }
1110: }
1111:
1112: ptr++;
1113: }
1114:
1115: if (niveau != 0)
1116: {
1117: liberation(s_etat_processus, s_objet);
1118:
1119: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1120: (*s_etat_processus).traitement_interruptible =
1121: registre_interruption;
1122: return;
1123: }
1124:
1125: drapeau_matrice = (niveau_maximal == 2) ? d_vrai : d_faux;
1126:
1127: switch (drapeau_matrice)
1128: {
1129:
1130: /*
1131: --------------------------------------------------------------------------------
1132: Vecteur
1133: --------------------------------------------------------------------------------
1134: */
1135:
1136: case d_faux :
1137: {
1138:
1139: /*
1140: -- Sauvegarde des paramètres du processus pour analyser le vecteur -------------
1141: -- Analyse récursive en appelant l'interprète sur le vecteur moins -------------
1142: -- ses délimiteurs -------------------------------------------------------------
1143: */
1144:
1145: sauvegarde_longueur_definitions_chainees =
1146: (*s_etat_processus).longueur_definitions_chainees;
1147:
1148: tampon = (unsigned char *) malloc(((size_t)
1149: (((*s_etat_processus).longueur_definitions_chainees
1150: = (integer8) strlen((*s_etat_processus)
1151: .instruction_courante) + 4) + 1)) *
1152: sizeof(unsigned char));
1153:
1154: if (tampon == NULL)
1155: {
1156: (*s_etat_processus).erreur_systeme =
1157: d_es_allocation_memoire;
1158: (*s_etat_processus).traitement_interruptible =
1159: registre_interruption;
1160: return;
1161: }
1162:
1163: strcpy(tampon, "<< ");
1164: ptr_ecriture = tampon + 3;
1165: ptr_lecture = (*s_etat_processus).instruction_courante + 1;
1166:
1167: while((*ptr_lecture) != d_code_fin_chaine)
1168: {
1169: *ptr_ecriture++ = *ptr_lecture++;
1170: }
1171:
1172: (*(--ptr_ecriture)) = d_code_fin_chaine;
1173: strcat(ptr_ecriture, " >>");
1174:
1175: position_courante = (*s_etat_processus).position_courante;
1176: (*s_etat_processus).position_courante = 0;
1177:
1178: profondeur_initiale = (*s_etat_processus)
1179: .hauteur_pile_operationnelle;
1180:
1181: /*
1182: -- On met le tout dans la pile opérationnelle ----------------------------------
1183: */
1184:
1185: (*s_etat_processus).niveau_recursivite++;
1186: definitions_chainees_precedentes = (*s_etat_processus)
1187: .definitions_chainees;
1188: (*s_etat_processus).definitions_chainees = tampon;
1189:
1190: s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
1191: sauvegarde_niveau_courant = (*s_etat_processus)
1192: .niveau_courant;
1193:
1194: (*s_etat_processus).l_base_pile_systeme = NULL;
1195: empilement_pile_systeme(s_etat_processus);
1196:
1197: if ((*s_etat_processus).erreur_systeme != d_es)
1198: {
1199: (*s_etat_processus).traitement_interruptible =
1200: registre_interruption;
1201: return;
1202: }
1203:
1204: (*(*s_etat_processus).l_base_pile_systeme)
1205: .retour_definition = 'Y';
1206: (*s_etat_processus).niveau_courant = 0;
1207: (*s_etat_processus).autorisation_empilement_programme = 'N';
1208: registre_mode_execution_programme =
1209: (*s_etat_processus).mode_execution_programme;
1210: (*s_etat_processus).mode_execution_programme = 'Y';
1211: (*s_etat_processus).erreur_scrutation = d_faux;
1212:
1213: tampon = (*s_etat_processus).instruction_courante;
1214: nombre_lignes_a_supprimer =
1215: (*s_etat_processus).hauteur_pile_operationnelle;
1216:
1217: if ((*s_etat_processus).profilage == d_vrai)
1218: {
1219: profilage(s_etat_processus, "RPL/2 internals");
1220:
1221: if ((*s_etat_processus).erreur_systeme != d_es)
1222: {
1223: return;
1224: }
1225: }
1226:
1227: registre_recherche_type =
1228: (*s_etat_processus).recherche_type;
1229: (*s_etat_processus).recherche_type = 'Y';
1230:
1231: if (sequenceur(s_etat_processus) == d_erreur)
1232: {
1233: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1234: (*s_etat_processus).recherche_type =
1235: registre_recherche_type;
1236: (*s_etat_processus).mode_execution_programme =
1237: registre_mode_execution_programme;
1238: nombre_lignes_a_supprimer =
1239: (*s_etat_processus).hauteur_pile_operationnelle
1240: - nombre_lignes_a_supprimer;
1241:
1242: for(i = 0; i < nombre_lignes_a_supprimer; i++)
1243: {
1244: if (depilement(s_etat_processus,
1245: &((*s_etat_processus).l_base_pile),
1246: &s_sous_objet) == d_erreur)
1247: {
1248: (*s_etat_processus).traitement_interruptible =
1249: registre_interruption;
1250: return;
1251: }
1252:
1253: liberation(s_etat_processus, s_sous_objet);
1254: }
1255:
1256: (*s_etat_processus).instruction_courante = tampon;
1257:
1258: effacement_pile_systeme(s_etat_processus);
1259: (*s_etat_processus).l_base_pile_systeme =
1260: s_sauvegarde_pile;
1261: (*s_etat_processus).niveau_courant =
1262: sauvegarde_niveau_courant;
1263:
1264: (*s_etat_processus).niveau_recursivite--;
1265: free((*s_etat_processus).definitions_chainees);
1266:
1267: (*s_etat_processus).position_courante =
1268: position_courante;
1269: (*s_etat_processus).definitions_chainees =
1270: definitions_chainees_precedentes;
1271: (*s_etat_processus).longueur_definitions_chainees =
1272: sauvegarde_longueur_definitions_chainees;
1273:
1274: liberation(s_etat_processus, s_objet);
1275:
1276: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1277: (*s_etat_processus).traitement_interruptible =
1278: registre_interruption;
1279: return;
1280: }
1281:
1282: (*s_etat_processus).recherche_type =
1283: registre_recherche_type;
1284: (*s_etat_processus).mode_execution_programme =
1285: registre_mode_execution_programme;
1286:
1287: if ((*s_etat_processus).erreur_scrutation == d_vrai)
1288: {
1289: nombre_lignes_a_supprimer =
1290: (*s_etat_processus).hauteur_pile_operationnelle
1291: - nombre_lignes_a_supprimer;
1292:
1293: for(i = 0; i < nombre_lignes_a_supprimer; i++)
1294: {
1295: if (depilement(s_etat_processus,
1296: &((*s_etat_processus).l_base_pile),
1297: &s_sous_objet) == d_erreur)
1298: {
1299: (*s_etat_processus).traitement_interruptible =
1300: registre_interruption;
1301: return;
1302: }
1303:
1304: liberation(s_etat_processus, s_sous_objet);
1305: }
1306:
1307: (*s_etat_processus).instruction_courante = tampon;
1308:
1309: effacement_pile_systeme(s_etat_processus);
1310: (*s_etat_processus).l_base_pile_systeme =
1311: s_sauvegarde_pile;
1312: (*s_etat_processus).niveau_courant =
1313: sauvegarde_niveau_courant;
1314:
1315: (*s_etat_processus).niveau_recursivite--;
1316: free((*s_etat_processus).definitions_chainees);
1317:
1318: (*s_etat_processus).position_courante =
1319: position_courante;
1320: (*s_etat_processus).definitions_chainees =
1321: definitions_chainees_precedentes;
1322: (*s_etat_processus).longueur_definitions_chainees =
1323: sauvegarde_longueur_definitions_chainees;
1324:
1325: liberation(s_etat_processus, s_objet);
1326:
1327: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1328: (*s_etat_processus).traitement_interruptible =
1329: registre_interruption;
1330: return;
1331: }
1332:
1333: (*s_etat_processus).instruction_courante = tampon;
1334:
1335: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
1336: (*s_etat_processus).niveau_courant =
1337: sauvegarde_niveau_courant;
1338:
1339: (*s_etat_processus).niveau_recursivite--;
1340:
1341: (*s_etat_processus).position_courante = position_courante;
1342: free((*s_etat_processus).definitions_chainees);
1343: (*s_etat_processus).definitions_chainees =
1344: definitions_chainees_precedentes;
1345: (*s_etat_processus).longueur_definitions_chainees =
1346: sauvegarde_longueur_definitions_chainees;
1347:
1348: /*
1349: -- On relit la pile pour remplir le vecteur ------------------------------------
1350: */
1351:
1352: profondeur_finale = (*s_etat_processus)
1353: .hauteur_pile_operationnelle;
1354: nombre_colonnes = profondeur_finale - profondeur_initiale;
1355:
1356: element = (void *) ((struct_vecteur *)
1357: malloc(sizeof(struct_vecteur)));
1358:
1359: if (element == NULL)
1360: {
1361: (*s_etat_processus).erreur_systeme =
1362: d_es_allocation_memoire;
1363: (*s_etat_processus).traitement_interruptible =
1364: registre_interruption;
1365: return;
1366: }
1367:
1368: (*((struct_vecteur *) element)).taille = nombre_colonnes;
1369:
1370: if (drapeau_complexe == d_vrai)
1371: {
1372: (*((struct_vecteur *) element)).tableau = (void *)
1373: ((struct_complexe16 *) malloc(((size_t)
1374: nombre_colonnes) *
1375: sizeof(struct_complexe16)));
1376: (*((struct_vecteur *) element)).type = 'C';
1377: }
1378: else if (drapeau_reel == d_vrai)
1379: {
1380: (*((struct_vecteur *) element)).tableau = (void *)
1381: ((real8 *) malloc(((size_t) nombre_colonnes) *
1382: sizeof(real8)));
1383: (*((struct_vecteur *) element)).type = 'R';
1384: }
1385: else
1386: {
1387: (*((struct_vecteur *) element)).tableau = (void *)
1388: ((integer8 *) malloc(((size_t) nombre_colonnes)
1389: * sizeof(integer8)));
1390: (*((struct_vecteur *) element)).type = 'I';
1391: }
1392:
1393: if ((*((struct_vecteur *) element)).tableau == NULL)
1394: {
1395: (*s_etat_processus).erreur_systeme =
1396: d_es_allocation_memoire;
1397: (*s_etat_processus).traitement_interruptible =
1398: registre_interruption;
1399: return;
1400: }
1401:
1402: erreur = d_absence_erreur;
1403: s_objet_registre = s_objet;
1404:
1405: for(i = 0; (i < nombre_colonnes) &&
1406: (erreur == d_absence_erreur); i++)
1407: {
1408: erreur = depilement(s_etat_processus,
1409: &((*s_etat_processus).l_base_pile), &s_objet);
1410:
1411: if (erreur == d_absence_erreur)
1412: {
1413: if (drapeau_complexe == d_vrai)
1414: {
1415: if ((*s_objet).type == CPL)
1416: {
1417: ((struct_complexe16 *) (*((struct_vecteur *)
1418: element)).tableau)[nombre_colonnes
1419: - i - 1] = *((struct_complexe16 *)
1420: ((*s_objet).objet));
1421: }
1422: else if ((*s_objet).type == REL)
1423: {
1424: ((struct_complexe16 *) (*((struct_vecteur *)
1425: element)).tableau)[nombre_colonnes
1426: - i - 1].partie_reelle =
1427: *((real8 *) ((*s_objet).objet));
1428: ((struct_complexe16 *) (*((struct_vecteur *)
1429: element)).tableau)[nombre_colonnes
1430: - i - 1].partie_imaginaire =
1431: (real8) 0;
1432: }
1433: else if ((*s_objet).type == INT)
1434: {
1435: ((struct_complexe16 *) (*((struct_vecteur *)
1436: element)).tableau)[nombre_colonnes
1437: - i - 1].partie_reelle = (real8)
1438: (*((integer8 *) ((*s_objet)
1439: .objet)));
1440: ((struct_complexe16 *) (*((struct_vecteur *)
1441: element)).tableau) [nombre_colonnes
1442: - i - 1].partie_imaginaire =
1443: (real8) 0;
1444: }
1445: else
1446: {
1447: erreur = d_erreur;
1448: }
1449: }
1450: else if (drapeau_reel == d_vrai)
1451: {
1452: if ((*s_objet).type == REL)
1453: {
1454: ((real8 *) (*((struct_vecteur *)
1455: element)).tableau)
1456: [nombre_colonnes - i - 1] =
1457: *((real8 *) ((*s_objet).objet));
1458: }
1459: else if ((*s_objet).type == INT)
1460: {
1461: ((real8 *) (*((struct_vecteur *)
1462: element)).tableau)
1463: [nombre_colonnes - i - 1] =
1464: (real8) (*((integer8 *)
1465: ((*s_objet).objet)));
1466: }
1467: else
1468: {
1469: erreur = d_erreur;
1470: }
1471: }
1472: else
1473: {
1474: if ((*s_objet).type == INT)
1475: {
1476: ((integer8 *) (*((struct_vecteur *)
1477: element)).tableau)
1478: [nombre_colonnes - i - 1] =
1479: *((integer8 *) ((*s_objet).objet));
1480: }
1481: else
1482: {
1483: erreur = d_erreur;
1484: }
1485: }
1486:
1487: liberation(s_etat_processus, s_objet);
1488:
1489: if (erreur == d_erreur)
1490: {
1491: for(i++; i < nombre_colonnes; i++)
1492: {
1493: if (depilement(s_etat_processus,
1494: &((*s_etat_processus).l_base_pile),
1495: &s_objet) == d_erreur)
1496: {
1497: (*s_etat_processus)
1498: .traitement_interruptible =
1499: registre_interruption;
1500: liberation(s_etat_processus,
1501: s_objet_registre);
1502: return;
1503: }
1504:
1505: liberation(s_etat_processus, s_objet);
1506: }
1507:
1508: (*s_etat_processus).erreur_execution =
1509: d_ex_syntaxe;
1510:
1511: free((*((struct_vecteur *) element)).tableau);
1512: free(element);
1513:
1514: liberation(s_etat_processus, s_objet_registre);
1515: (*s_etat_processus).traitement_interruptible =
1516: registre_interruption;
1517: return;
1518: }
1519: }
1520: else
1521: {
1522: liberation(s_etat_processus, s_objet_registre);
1523:
1524: (*s_etat_processus).erreur_systeme = d_es_pile_vide;
1525: (*s_etat_processus).traitement_interruptible =
1526: registre_interruption;
1527: return;
1528: }
1529: }
1530:
1531: s_objet = s_objet_registre;
1532:
1533: if (drapeau_complexe == d_vrai)
1534: {
1535: (*s_objet).type = VCX;
1536: }
1537: else if (drapeau_reel == d_vrai)
1538: {
1539: (*s_objet).type = VRL;
1540: }
1541: else
1542: {
1543: (*s_objet).type = VIN;
1544: }
1545:
1546: break;
1547: }
1548:
1549: /*
1550: --------------------------------------------------------------------------------
1551: Matrice
1552: --------------------------------------------------------------------------------
1553: */
1554:
1555: case d_vrai :
1556: {
1557: nombre_lignes--;
1558:
1559: sauvegarde_longueur_definitions_chainees =
1560: (*s_etat_processus).longueur_definitions_chainees;
1561:
1562: tampon = (unsigned char *) malloc(((size_t)
1563: (((*s_etat_processus).longueur_definitions_chainees
1564: = (integer8) strlen((*s_etat_processus)
1565: .instruction_courante) + 4) + 1)) *
1566: sizeof(unsigned char));
1567:
1568: if (tampon == NULL)
1569: {
1570: (*s_etat_processus).erreur_systeme =
1571: d_es_allocation_memoire;
1572: (*s_etat_processus).traitement_interruptible =
1573: registre_interruption;
1574: return;
1575: }
1576:
1577: strcpy(tampon, "<< ");
1578: ptr_ecriture = tampon + 3;
1579: ptr_lecture = (*s_etat_processus).instruction_courante + 1;
1580:
1581: while((*ptr_lecture) != d_code_fin_chaine)
1582: {
1583: *ptr_ecriture++ = *ptr_lecture++;
1584: }
1585:
1586: (*(--ptr_ecriture)) = d_code_fin_chaine;
1587: strcat(ptr_ecriture, " >>");
1588:
1589: position_courante = (*s_etat_processus).position_courante;
1590: (*s_etat_processus).position_courante = 0;
1591:
1592: profondeur_initiale = (*s_etat_processus)
1593: .hauteur_pile_operationnelle;
1594:
1595: /*
1596: -- On met les lignes de la matrice dans la pile opérationnelle -----------------
1597: */
1598:
1599: (*s_etat_processus).niveau_recursivite++;
1600: definitions_chainees_precedentes = (*s_etat_processus)
1601: .definitions_chainees;
1602: (*s_etat_processus).definitions_chainees = tampon;
1603:
1604: s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
1605: sauvegarde_niveau_courant = (*s_etat_processus)
1606: .niveau_courant;
1607:
1608: (*s_etat_processus).l_base_pile_systeme = NULL;
1609: empilement_pile_systeme(s_etat_processus);
1610:
1611: if ((*s_etat_processus).erreur_systeme != d_es)
1612: {
1613: (*s_etat_processus).traitement_interruptible =
1614: registre_interruption;
1615: return;
1616: }
1617:
1618: (*(*s_etat_processus).l_base_pile_systeme)
1619: .retour_definition = 'Y';
1620: (*s_etat_processus).niveau_courant = 0;
1621: (*s_etat_processus).autorisation_empilement_programme = 'N';
1622: registre_mode_execution_programme =
1623: (*s_etat_processus).mode_execution_programme;
1624: (*s_etat_processus).mode_execution_programme = 'Y';
1625: (*s_etat_processus).erreur_scrutation = d_faux;
1626:
1627: tampon = (*s_etat_processus).instruction_courante;
1628: nombre_lignes_a_supprimer =
1629: (*s_etat_processus).hauteur_pile_operationnelle;
1630:
1631: if ((*s_etat_processus).profilage == d_vrai)
1632: {
1633: profilage(s_etat_processus, "RPL/2 internals");
1634:
1635: if ((*s_etat_processus).erreur_systeme != d_es)
1636: {
1637: return;
1638: }
1639: }
1640:
1641: registre_recherche_type = (*s_etat_processus)
1642: .recherche_type;
1643: (*s_etat_processus).recherche_type = 'Y';
1644:
1645: if (sequenceur(s_etat_processus) == d_erreur)
1646: {
1647: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1648: (*s_etat_processus).recherche_type =
1649: registre_recherche_type;
1650: (*s_etat_processus).mode_execution_programme =
1651: registre_mode_execution_programme;
1652: nombre_lignes_a_supprimer =
1653: (*s_etat_processus).hauteur_pile_operationnelle
1654: - nombre_lignes_a_supprimer;
1655:
1656: for(i = 0; i < nombre_lignes_a_supprimer; i++)
1657: {
1658: if (depilement(s_etat_processus,
1659: &((*s_etat_processus).l_base_pile),
1660: &s_sous_objet) == d_erreur)
1661: {
1662: (*s_etat_processus).traitement_interruptible =
1663: registre_interruption;
1664: return;
1665: }
1666:
1667: liberation(s_etat_processus, s_sous_objet);
1668: }
1669:
1670: (*s_etat_processus).instruction_courante = tampon;
1671:
1672: effacement_pile_systeme(s_etat_processus);
1673: (*s_etat_processus).l_base_pile_systeme =
1674: s_sauvegarde_pile;
1675: (*s_etat_processus).niveau_courant =
1676: sauvegarde_niveau_courant;
1677:
1678: free((*s_etat_processus).definitions_chainees);
1679: (*s_etat_processus).niveau_recursivite--;
1680:
1681: (*s_etat_processus).definitions_chainees =
1682: definitions_chainees_precedentes;
1683: (*s_etat_processus).longueur_definitions_chainees =
1684: sauvegarde_longueur_definitions_chainees;
1685:
1686: (*s_etat_processus).position_courante =
1687: position_courante;
1688:
1689: liberation(s_etat_processus, s_objet);
1690:
1691: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1692: (*s_etat_processus).traitement_interruptible =
1693: registre_interruption;
1694: return;
1695: }
1696:
1697: (*s_etat_processus).recherche_type =
1698: registre_recherche_type;
1699: (*s_etat_processus).mode_execution_programme =
1700: registre_mode_execution_programme;
1701:
1702: if ((*s_etat_processus).erreur_scrutation == d_vrai)
1703: {
1704: nombre_lignes_a_supprimer =
1705: (*s_etat_processus).hauteur_pile_operationnelle
1706: - nombre_lignes_a_supprimer;
1707:
1708: for(i = 0; i < nombre_lignes_a_supprimer; i++)
1709: {
1710: if (depilement(s_etat_processus,
1711: &((*s_etat_processus).l_base_pile),
1712: &s_sous_objet) == d_erreur)
1713: {
1714: (*s_etat_processus).traitement_interruptible =
1715: registre_interruption;
1716: return;
1717: }
1718:
1719: liberation(s_etat_processus, s_sous_objet);
1720: }
1721:
1722: (*s_etat_processus).instruction_courante = tampon;
1723:
1724: effacement_pile_systeme(s_etat_processus);
1725: (*s_etat_processus).l_base_pile_systeme =
1726: s_sauvegarde_pile;
1727: (*s_etat_processus).niveau_courant =
1728: sauvegarde_niveau_courant;
1729:
1730: free((*s_etat_processus).definitions_chainees);
1731: (*s_etat_processus).niveau_recursivite--;
1732:
1733: (*s_etat_processus).definitions_chainees =
1734: definitions_chainees_precedentes;
1735: (*s_etat_processus).longueur_definitions_chainees =
1736: sauvegarde_longueur_definitions_chainees;
1737:
1738: (*s_etat_processus).position_courante =
1739: position_courante;
1740:
1741: liberation(s_etat_processus, s_objet);
1742:
1743: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1744: (*s_etat_processus).traitement_interruptible =
1745: registre_interruption;
1746: return;
1747: }
1748:
1749: (*s_etat_processus).instruction_courante = tampon;
1750:
1751: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
1752: (*s_etat_processus).niveau_courant =
1753: sauvegarde_niveau_courant;
1754:
1755: free((*s_etat_processus).definitions_chainees);
1756: (*s_etat_processus).definitions_chainees =
1757: definitions_chainees_precedentes;
1758: (*s_etat_processus).longueur_definitions_chainees =
1759: sauvegarde_longueur_definitions_chainees;
1760:
1761: (*s_etat_processus).niveau_recursivite--;
1762:
1763: (*s_etat_processus).position_courante = position_courante;
1764:
1765: /*
1766: -- On relit la pile qui contient des objets "vecteurs" contenant les -----------
1767: -- lignes de la matrice --------------------------------------------------------
1768: */
1769:
1770: profondeur_finale = (*s_etat_processus)
1771: .hauteur_pile_operationnelle;
1772:
1773: nombre_lignes = profondeur_finale - profondeur_initiale;
1774:
1775: element = (void *) ((struct_matrice *) malloc(
1776: sizeof(struct_matrice)));
1777:
1778: if (element == NULL)
1779: {
1780: (*s_etat_processus).erreur_systeme =
1781: d_es_allocation_memoire;
1782: (*s_etat_processus).traitement_interruptible =
1783: registre_interruption;
1784: return;
1785: }
1786:
1787: (*((struct_matrice *) element))
1788: .nombre_lignes = nombre_lignes;
1789: (*((struct_matrice *) element)).nombre_colonnes =
1790: (*((struct_vecteur *) ((*(*(*s_etat_processus)
1791: .l_base_pile).donnee).objet))).taille;
1792: nombre_colonnes = (*((struct_matrice *)
1793: element)).nombre_colonnes;
1794:
1795: l_element_courant = (*s_etat_processus).l_base_pile;
1796:
1797: drapeau_complexe = d_faux;
1798: drapeau_reel = d_faux;
1799: erreur = d_absence_erreur;
1800:
1801: for(i = 0; i < nombre_lignes; i++)
1802: {
1803: if (nombre_colonnes != (*((struct_vecteur *)
1804: (*(*l_element_courant).donnee).objet)).taille)
1805: {
1806: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1807:
1808: for(j = 0; j < nombre_lignes; j++)
1809: {
1810: if (depilement(s_etat_processus,
1811: &((*s_etat_processus).l_base_pile),
1812: &s_sous_objet) == d_erreur)
1813: {
1814: (*s_etat_processus)
1815: .traitement_interruptible =
1816: registre_interruption;
1817: return;
1818: }
1819:
1820: liberation(s_etat_processus, s_sous_objet);
1821: }
1822:
1823: free(element);
1824: liberation(s_etat_processus, s_objet);
1825:
1826: (*s_etat_processus).traitement_interruptible =
1827: registre_interruption;
1828: return;
1829: }
1830:
1831: if ((*(*l_element_courant)
1832: .donnee).type == VRL)
1833: {
1834: drapeau_reel = d_vrai;
1835: }
1836: else if ((*(*l_element_courant)
1837: .donnee).type == VCX)
1838: {
1839: drapeau_complexe = d_vrai;
1840: }
1841:
1842: l_element_courant = (*l_element_courant).suivant;
1843: }
1844:
1845: s_objet_registre = s_objet;
1846:
1847: if ((*s_etat_processus).erreur_execution == d_ex)
1848: {
1849: if (drapeau_complexe == d_vrai)
1850: {
1851: if (((*((struct_matrice *) element)).tableau =
1852: (void **) ((struct_complexe16 **)
1853: malloc(((size_t) nombre_lignes) * sizeof(
1854: struct_complexe16 *)))) == NULL)
1855: {
1856: liberation(s_etat_processus, s_objet_registre);
1857:
1858: (*s_etat_processus).erreur_systeme =
1859: d_es_allocation_memoire;
1860: (*s_etat_processus).traitement_interruptible =
1861: registre_interruption;
1862: return;
1863: }
1864:
1865: (*((struct_matrice *) element)).type = 'C';
1866:
1867: for(i = 0; i < nombre_lignes; i++)
1868: {
1869: if ((((*((struct_matrice *)
1870: element)).tableau)[i] = (void *)
1871: ((struct_complexe16 *)
1872: malloc(((size_t) nombre_colonnes) *
1873: sizeof(struct_complexe16)))) == NULL)
1874: {
1875: liberation(s_etat_processus,
1876: s_objet_registre);
1877:
1878: (*s_etat_processus).erreur_systeme =
1879: d_es_allocation_memoire;
1880: (*s_etat_processus)
1881: .traitement_interruptible =
1882: registre_interruption;
1883: return;
1884: }
1885: }
1886: }
1887: else if (drapeau_reel == d_vrai)
1888: {
1889: if (((*((struct_matrice *) element)).tableau =
1890: (void **) ((real8 **) malloc(((size_t)
1891: nombre_lignes) * sizeof(real8 *))))
1892: == NULL)
1893: {
1894: liberation(s_etat_processus, s_objet_registre);
1895:
1896: (*s_etat_processus).erreur_systeme =
1897: d_es_allocation_memoire;
1898: (*s_etat_processus).traitement_interruptible =
1899: registre_interruption;
1900: return;
1901: }
1902:
1903: (*((struct_matrice *) element)).type = 'R';
1904:
1905: for(i = 0; i < nombre_lignes; i++)
1906: {
1907: if ((((*((struct_matrice *)element)).tableau)[i]
1908: = (void *) ((real8 *)
1909: malloc(((size_t) nombre_colonnes) *
1910: sizeof(real8)))) == NULL)
1911: {
1912: liberation(s_etat_processus,
1913: s_objet_registre);
1914:
1915: (*s_etat_processus).erreur_systeme =
1916: d_es_allocation_memoire;
1917: (*s_etat_processus)
1918: .traitement_interruptible =
1919: registre_interruption;
1920: return;
1921: }
1922: }
1923: }
1924: else
1925: {
1926: if (((*((struct_matrice *) element)).tableau =
1927: (void **) ((integer8 **)
1928: malloc(((size_t) nombre_lignes) *
1929: sizeof(integer8 *)))) == NULL)
1930: {
1931: liberation(s_etat_processus, s_objet_registre);
1932:
1933: (*s_etat_processus).erreur_systeme =
1934: d_es_allocation_memoire;
1935: (*s_etat_processus).traitement_interruptible =
1936: registre_interruption;
1937: return;
1938: }
1939:
1940: (*((struct_matrice *) element)).type = 'I';
1941:
1942: for(i = 0; i < nombre_lignes; i++)
1943: {
1944: if ((((*((struct_matrice *)
1945: element)).tableau)[i] = (void *)
1946: ((integer8 *)
1947: malloc(((size_t) nombre_colonnes) *
1948: sizeof(integer8)))) == NULL)
1949: {
1950: liberation(s_etat_processus,
1951: s_objet_registre);
1952:
1953: (*s_etat_processus).erreur_systeme =
1954: d_es_allocation_memoire;
1955: (*s_etat_processus)
1956: .traitement_interruptible =
1957: registre_interruption;
1958: return;
1959: }
1960: }
1961: }
1962:
1963: for(i = 0; i < nombre_lignes; i++)
1964: {
1965: if (depilement(s_etat_processus,
1966: &((*s_etat_processus)
1967: .l_base_pile), &s_objet) ==
1968: d_absence_erreur)
1969: {
1970: if (drapeau_complexe == d_vrai)
1971: {
1972: if ((*s_objet).type == VCX)
1973: {
1974: for(j = 0; j < nombre_colonnes; j++)
1975: {
1976: ((struct_complexe16 **) ((*(
1977: (struct_matrice *) element))
1978: .tableau))[nombre_lignes - i
1979: - 1][j] =
1980: ((struct_complexe16 *)
1981: (*((struct_vecteur *)
1982: (*s_objet).objet))
1983: .tableau)[j];
1984: }
1985: }
1986: else if ((*s_objet).type == VRL)
1987: {
1988: for(j = 0; j < nombre_colonnes; j++)
1989: {
1990: (((struct_complexe16 **) ((*(
1991: (struct_matrice *) element))
1992: .tableau))[nombre_lignes - i
1993: - 1][j]).partie_reelle =
1994: ((real8 *) (*(
1995: (struct_vecteur *)
1996: (*s_objet).objet))
1997: .tableau)[j];
1998: (((struct_complexe16 **) ((*(
1999: (struct_matrice *) element))
2000: .tableau))[nombre_lignes - i
2001: - 1][j]).partie_imaginaire =
2002: (real8) 0;
2003: }
2004: }
2005: else if ((*s_objet).type == VIN)
2006: {
2007: for(j = 0; j < nombre_colonnes; j++)
2008: {
2009: (((struct_complexe16 **) ((*(
2010: (struct_matrice *) element))
2011: .tableau))[nombre_lignes - i
2012: - 1][j]).partie_reelle =
2013: (real8) ((integer8 *)
2014: (*((struct_vecteur *)
2015: (*s_objet).objet)).tableau)
2016: [j];
2017: (((struct_complexe16 **) ((*(
2018: (struct_matrice *) element))
2019: .tableau))[nombre_lignes - i
2020: - 1][j]).partie_imaginaire =
2021: (real8) 0;
2022: }
2023: }
2024: else
2025: {
2026: erreur = d_erreur;
2027: }
2028: }
2029: else if (drapeau_reel == d_vrai)
2030: {
2031: if ((*s_objet).type == VRL)
2032: {
2033: for(j = 0; j < nombre_colonnes; j++)
2034: {
2035: ((real8 **) ((*((struct_matrice *)
2036: element)).tableau))
2037: [nombre_lignes - i - 1][j] =
2038: ((real8 *) (*(
2039: (struct_vecteur *)
2040: (*s_objet).objet)).tableau)
2041: [j];
2042: }
2043: }
2044: else if ((*s_objet).type == VIN)
2045: {
2046: for(j = 0; j < nombre_colonnes; j++)
2047: {
2048: ((real8 **) ((*((struct_matrice *)
2049: element)).tableau))
2050: [nombre_lignes - i - 1][j] =
2051: (real8) ((integer8 *)
2052: (*((struct_vecteur *)
2053: (*s_objet).objet)).tableau)
2054: [j];
2055: }
2056: }
2057: else
2058: {
2059: erreur = d_erreur;
2060: }
2061: }
2062: else
2063: {
2064: if ((*s_objet).type == VIN)
2065: {
2066: for(j = 0; j < nombre_colonnes; j++)
2067: {
2068: ((integer8 **)
2069: ((*((struct_matrice *)
2070: element)).tableau))
2071: [nombre_lignes - i - 1][j] =
2072: ((integer8 *)
2073: (*((struct_vecteur *)
2074: (*s_objet)
2075: .objet)).tableau)[j];
2076: }
2077: }
2078: else
2079: {
2080: erreur = d_erreur;
2081: }
2082: }
2083:
2084: liberation(s_etat_processus, s_objet);
2085:
2086: if (erreur == d_erreur)
2087: {
2088: for(i++; i < nombre_lignes; i++)
2089: {
2090: if (depilement(s_etat_processus,
2091: &((*s_etat_processus)
2092: .l_base_pile), &s_objet)
2093: == d_erreur)
2094: {
2095: liberation(s_etat_processus,
2096: s_objet_registre);
2097:
2098: (*s_etat_processus)
2099: .traitement_interruptible =
2100: registre_interruption;
2101: return;
2102: }
2103:
2104: liberation(s_etat_processus, s_objet);
2105: }
2106:
2107: (*s_etat_processus).erreur_execution =
2108: d_ex_syntaxe;
2109:
2110: for(j = 0; j < (*((struct_matrice *)
2111: element)).nombre_lignes; j++)
2112: {
2113: free((*((struct_matrice *) element))
2114: .tableau[j]);
2115: }
2116:
2117: free((*((struct_matrice *) element))
2118: .tableau);
2119: free(element);
2120:
2121: liberation(s_etat_processus,
2122: s_objet_registre);
2123:
2124: (*s_etat_processus)
2125: .traitement_interruptible =
2126: registre_interruption;
2127: return;
2128: }
2129: }
2130: else
2131: {
2132: liberation(s_etat_processus,
2133: s_objet_registre);
2134:
2135: (*s_etat_processus).erreur_systeme =
2136: d_es_pile_vide;
2137: (*s_etat_processus).traitement_interruptible =
2138: registre_interruption;
2139: return;
2140: }
2141: }
2142:
2143: s_objet = s_objet_registre;
2144:
2145: if (drapeau_complexe == d_vrai)
2146: {
2147: (*s_objet).type = MCX;
2148: }
2149: else if (drapeau_reel == d_vrai)
2150: {
2151: (*s_objet).type = MRL;
2152: }
2153: else
2154: {
2155: (*s_objet).type = MIN;
2156: }
2157: }
2158: else
2159: {
2160: if ((*s_etat_processus).langue == 'F')
2161: {
2162: printf("+++Erreur : Matrice %s invalide [%d]\n",
2163: (*s_etat_processus).instruction_courante,
2164: (int) getpid());
2165: }
2166: else
2167: {
2168: printf("+++Error : Invalid %s matrix [%d]\n",
2169: (*s_etat_processus).instruction_courante,
2170: (int) getpid());
2171: }
2172:
2173: fflush(stdout);
2174: }
2175:
2176: break;
2177: }
2178: }
2179:
2180: break;
2181: }
2182:
2183: /*
2184: --------------------------------------------------------------------------------
2185: Liste
2186: --------------------------------------------------------------------------------
2187: */
2188:
2189: case '{' :
2190: {
2191: sauvegarde_longueur_definitions_chainees =
2192: (*s_etat_processus).longueur_definitions_chainees;
2193:
2194: tampon = (unsigned char *) malloc(((size_t)
2195: (((*s_etat_processus).longueur_definitions_chainees =
2196: (integer8) strlen((*s_etat_processus)
2197: .instruction_courante) + 4) + 1)) * sizeof(unsigned char));
2198:
2199: if (tampon == NULL)
2200: {
2201: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2202: (*s_etat_processus).traitement_interruptible =
2203: registre_interruption;
2204: return;
2205: }
2206:
2207: strcpy(tampon, "<< ");
2208: ptr_ecriture = tampon + 3;
2209: ptr_lecture = (*s_etat_processus).instruction_courante + 1;
2210:
2211: while((*ptr_lecture) != d_code_fin_chaine)
2212: {
2213: *ptr_ecriture++ = *ptr_lecture++;
2214: }
2215:
2216: (*(--ptr_ecriture)) = d_code_fin_chaine;
2217: strcat(ptr_ecriture, " >>");
2218:
2219: position_courante = (*s_etat_processus).position_courante;
2220: (*s_etat_processus).position_courante = 0;
2221:
2222: profondeur_initiale = (*s_etat_processus)
2223: .hauteur_pile_operationnelle;
2224:
2225: /*
2226: -- On met le tout dans la pile opérationnelle. ---------------------------------
2227: */
2228:
2229: (*s_etat_processus).niveau_recursivite++;
2230: definitions_chainees_precedentes = (*s_etat_processus)
2231: .definitions_chainees;
2232: (*s_etat_processus).definitions_chainees = tampon;
2233:
2234: s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
2235: sauvegarde_niveau_courant = (*s_etat_processus).niveau_courant;
2236:
2237: (*s_etat_processus).l_base_pile_systeme = NULL;
2238: empilement_pile_systeme(s_etat_processus);
2239:
2240: if ((*s_etat_processus).erreur_systeme != d_es)
2241: {
2242: (*s_etat_processus).traitement_interruptible =
2243: registre_interruption;
2244: return;
2245: }
2246:
2247: (*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'Y';
2248: (*(*s_etat_processus).l_base_pile_systeme)
2249: .origine_routine_evaluation = 'N';
2250: (*s_etat_processus).niveau_courant = 0;
2251: (*s_etat_processus).autorisation_empilement_programme = 'N';
2252:
2253: tampon = (*s_etat_processus).instruction_courante;
2254: autorisation_evaluation_nom = (*s_etat_processus)
2255: .autorisation_evaluation_nom;
2256: (*s_etat_processus).autorisation_evaluation_nom = 'N';
2257:
2258: registre_test = (*s_etat_processus).test_instruction;
2259: (*s_etat_processus).test_instruction = 'Y';
2260: registre_mode_execution_programme =
2261: (*s_etat_processus).mode_execution_programme;
2262: (*s_etat_processus).mode_execution_programme = 'Y';
2263: (*s_etat_processus).erreur_scrutation = d_faux;
2264:
2265: nombre_lignes_a_supprimer =
2266: (*s_etat_processus).hauteur_pile_operationnelle;
2267:
2268: /*
2269: * Vérification de la cohérence des arguments.
2270: * Il doit y avoir autant de '<<' que de '>>' dans
2271: * l'expression candidate.
2272: */
2273:
2274: coherence_liste = 0;
2275: drapeau_chaine = d_faux;
2276:
2277: while((*s_etat_processus).definitions_chainees
2278: [(*s_etat_processus).position_courante] !=
2279: d_code_fin_chaine)
2280: {
2281: if ((*s_etat_processus).definitions_chainees
2282: [(*s_etat_processus).position_courante] == '"')
2283: {
2284: if ((*s_etat_processus).position_courante > 0)
2285: {
2286: if ((*s_etat_processus).definitions_chainees
2287: [(*s_etat_processus).position_courante - 1]
2288: != '\\')
2289: {
2290: if (drapeau_chaine == d_faux)
2291: {
2292: drapeau_chaine = d_vrai;
2293: }
2294: else
2295: {
2296: drapeau_chaine = d_faux;
2297: }
2298: }
2299: }
2300: else
2301: {
2302: if (drapeau_chaine == d_faux)
2303: {
2304: drapeau_chaine = d_vrai;
2305: }
2306: else
2307: {
2308: drapeau_chaine = d_faux;
2309: }
2310: }
2311: }
2312: else if (drapeau_chaine == d_faux)
2313: {
2314: if (((*s_etat_processus).definitions_chainees
2315: [(*s_etat_processus).position_courante] == '<') &&
2316: ((*s_etat_processus).definitions_chainees
2317: [(*s_etat_processus).position_courante + 1] == '<'))
2318: {
2319: coherence_liste++;
2320: }
2321: else if (((*s_etat_processus).definitions_chainees
2322: [(*s_etat_processus).position_courante] == '>') &&
2323: ((*s_etat_processus).definitions_chainees
2324: [(*s_etat_processus).position_courante + 1] == '>'))
2325: {
2326: coherence_liste--;
2327: }
2328:
2329: }
2330:
2331: (*s_etat_processus).position_courante++;
2332: }
2333:
2334: (*s_etat_processus).position_courante = 0;
2335:
2336: if ((coherence_liste != 0) || (drapeau_chaine == d_vrai))
2337: {
2338: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2339:
2340: nombre_lignes_a_supprimer =
2341: (*s_etat_processus).hauteur_pile_operationnelle
2342: - nombre_lignes_a_supprimer;
2343:
2344: for(i = 0; i < nombre_lignes_a_supprimer; i++)
2345: {
2346: if (depilement(s_etat_processus, &((*s_etat_processus)
2347: .l_base_pile), &s_sous_objet) == d_erreur)
2348: {
2349: (*s_etat_processus).traitement_interruptible =
2350: registre_interruption;
2351: (*s_etat_processus).mode_execution_programme =
2352: registre_mode_execution_programme;
2353: return;
2354: }
2355:
2356: liberation(s_etat_processus, s_sous_objet);
2357: }
2358:
2359: (*s_etat_processus).test_instruction = registre_test;
2360: (*s_etat_processus).longueur_definitions_chainees =
2361: sauvegarde_longueur_definitions_chainees;
2362:
2363: (*s_etat_processus).instruction_courante = tampon;
2364: (*s_etat_processus).autorisation_evaluation_nom =
2365: autorisation_evaluation_nom;
2366:
2367: effacement_pile_systeme(s_etat_processus);
2368: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2369: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2370:
2371: free((*s_etat_processus).definitions_chainees);
2372: liberation(s_etat_processus, s_objet);
2373:
2374: (*s_etat_processus).definitions_chainees =
2375: definitions_chainees_precedentes;
2376:
2377: (*s_etat_processus).niveau_recursivite--;
2378:
2379: (*s_etat_processus).position_courante = position_courante;
2380:
2381: (*s_etat_processus).traitement_interruptible =
2382: registre_interruption;
2383: (*s_etat_processus).mode_execution_programme =
2384: registre_mode_execution_programme;
2385: return;
2386: }
2387:
2388: /*
2389: * Scrutation de la séquence.
2390: */
2391:
2392: (*s_etat_processus).position_courante = 0;
2393:
2394: if ((*s_etat_processus).profilage == d_vrai)
2395: {
2396: profilage(s_etat_processus, "RPL/2 internals");
2397:
2398: if ((*s_etat_processus).erreur_systeme != d_es)
2399: {
2400: return;
2401: }
2402: }
2403:
2404: variable_implicite = (*s_etat_processus).autorisation_nom_implicite;
2405: registre_recherche_type = (*s_etat_processus).recherche_type;
2406: (*s_etat_processus).recherche_type = 'Y';
2407: (*s_etat_processus).autorisation_nom_implicite = 'Y';
2408:
2409: if (sequenceur(s_etat_processus) == d_erreur)
2410: {
2411: (*s_etat_processus).autorisation_nom_implicite =
2412: variable_implicite;
2413: (*s_etat_processus).recherche_type = registre_recherche_type;
2414: (*s_etat_processus).mode_execution_programme =
2415: registre_mode_execution_programme;
2416:
2417: if ((*s_etat_processus).erreur_execution !=
2418: d_ex_nom_implicite)
2419: {
2420: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2421: }
2422:
2423: nombre_lignes_a_supprimer =
2424: (*s_etat_processus).hauteur_pile_operationnelle
2425: - nombre_lignes_a_supprimer;
2426:
2427: for(i = 0; i < nombre_lignes_a_supprimer; i++)
2428: {
2429: if (depilement(s_etat_processus, &((*s_etat_processus)
2430: .l_base_pile), &s_sous_objet) == d_erreur)
2431: {
2432: (*s_etat_processus).traitement_interruptible =
2433: registre_interruption;
2434: return;
2435: }
2436:
2437: liberation(s_etat_processus, s_sous_objet);
2438: }
2439:
2440: (*s_etat_processus).test_instruction = registre_test;
2441: (*s_etat_processus).longueur_definitions_chainees =
2442: sauvegarde_longueur_definitions_chainees;
2443:
2444: (*s_etat_processus).instruction_courante = tampon;
2445: (*s_etat_processus).autorisation_evaluation_nom =
2446: autorisation_evaluation_nom;
2447:
2448: effacement_pile_systeme(s_etat_processus);
2449: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2450: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2451:
2452: free((*s_etat_processus).definitions_chainees);
2453: liberation(s_etat_processus, s_objet);
2454:
2455: (*s_etat_processus).definitions_chainees =
2456: definitions_chainees_precedentes;
2457:
2458: (*s_etat_processus).niveau_recursivite--;
2459:
2460: (*s_etat_processus).position_courante = position_courante;
2461:
2462: (*s_etat_processus).traitement_interruptible =
2463: registre_interruption;
2464: return;
2465: }
2466:
2467: (*s_etat_processus).autorisation_nom_implicite = variable_implicite;
2468: (*s_etat_processus).recherche_type = registre_recherche_type;
2469: (*s_etat_processus).mode_execution_programme =
2470: registre_mode_execution_programme;
2471:
2472: if ((*s_etat_processus).erreur_scrutation == d_vrai)
2473: {
2474: nombre_lignes_a_supprimer =
2475: (*s_etat_processus).hauteur_pile_operationnelle
2476: - nombre_lignes_a_supprimer;
2477:
2478: for(i = 0; i < nombre_lignes_a_supprimer; i++)
2479: {
2480: if (depilement(s_etat_processus, &((*s_etat_processus)
2481: .l_base_pile), &s_sous_objet) == d_erreur)
2482: {
2483: (*s_etat_processus).traitement_interruptible =
2484: registre_interruption;
2485: return;
2486: }
2487:
2488: liberation(s_etat_processus, s_sous_objet);
2489: }
2490:
2491: (*s_etat_processus).test_instruction = registre_test;
2492: (*s_etat_processus).longueur_definitions_chainees =
2493: sauvegarde_longueur_definitions_chainees;
2494:
2495: (*s_etat_processus).instruction_courante = tampon;
2496: (*s_etat_processus).autorisation_evaluation_nom =
2497: autorisation_evaluation_nom;
2498:
2499: effacement_pile_systeme(s_etat_processus);
2500: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2501: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2502:
2503: free((*s_etat_processus).definitions_chainees);
2504: liberation(s_etat_processus, s_objet);
2505:
2506: (*s_etat_processus).definitions_chainees =
2507: definitions_chainees_precedentes;
2508:
2509: (*s_etat_processus).niveau_recursivite--;
2510: (*s_etat_processus).position_courante = position_courante;
2511:
2512: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2513: (*s_etat_processus).traitement_interruptible =
2514: registre_interruption;
2515: return;
2516: }
2517:
2518: (*s_etat_processus).test_instruction = registre_test;
2519: (*s_etat_processus).longueur_definitions_chainees =
2520: sauvegarde_longueur_definitions_chainees;
2521:
2522: (*s_etat_processus).instruction_courante = tampon;
2523: (*s_etat_processus).autorisation_evaluation_nom =
2524: autorisation_evaluation_nom;
2525:
2526: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2527: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2528:
2529: free((*s_etat_processus).definitions_chainees);
2530: (*s_etat_processus).definitions_chainees =
2531: definitions_chainees_precedentes;
2532:
2533: (*s_etat_processus).niveau_recursivite--;
2534:
2535: (*s_etat_processus).position_courante = position_courante;
2536:
2537: /*
2538: -- Relecture de la pile opérationnelle -----------------------------------------
2539: */
2540:
2541: profondeur_finale = (*s_etat_processus).hauteur_pile_operationnelle;
2542:
2543: l_element_courant = NULL;
2544: s_objet_registre = s_objet;
2545:
2546: for(i = 0; i < (profondeur_finale - profondeur_initiale); i++)
2547: {
2548: if (depilement(s_etat_processus,
2549: &((*s_etat_processus).l_base_pile),
2550: &s_objet) == d_erreur)
2551: {
2552: liberation(s_etat_processus, s_objet_registre);
2553: (*s_etat_processus).traitement_interruptible =
2554: registre_interruption;
2555: return;
2556: }
2557:
2558: if (empilement(s_etat_processus, &l_element_courant,
2559: s_objet) == d_erreur)
2560: {
2561: liberation(s_etat_processus, s_objet_registre);
2562: (*s_etat_processus).traitement_interruptible =
2563: registre_interruption;
2564: return;
2565: }
2566: }
2567:
2568: s_objet = s_objet_registre;
2569: (*s_objet).type = LST;
2570: element = (void *) l_element_courant;
2571:
2572: break;
2573: }
2574:
2575: /*
2576: --------------------------------------------------------------------------------
2577: Nom ou expression algébrique
2578: --------------------------------------------------------------------------------
2579: */
2580:
2581: case '\'' :
2582: {
2583: if ((tampon = analyse_algebrique(s_etat_processus,
2584: (*s_etat_processus).instruction_courante,
2585: &l_base_liste_fonctions)) == NULL)
2586: {
2587: /*
2588: * L'erreur est de type exécution ou système.
2589: * Dans le doute, on libère *s_objet.
2590: */
2591:
2592: while(l_base_liste_fonctions != NULL)
2593: {
2594: l_element_courant_fonctions = l_base_liste_fonctions;
2595: l_base_liste_fonctions = (*l_base_liste_fonctions).suivant;
2596:
2597: free((*((struct_fonction *) (*l_element_courant_fonctions)
2598: .donnee)).nom_fonction);
2599: free((struct_fonction *) (*l_element_courant_fonctions)
2600: .donnee);
2601: free(l_element_courant_fonctions);
2602: }
2603:
2604: liberation(s_etat_processus, s_objet);
2605:
2606: (*s_etat_processus).traitement_interruptible =
2607: registre_interruption;
2608: return;
2609: }
2610:
2611: l_base_liste_decomposition = analyse_rpn(s_etat_processus, tampon);
2612: l_element_courant = l_base_liste_decomposition;
2613: nombre_elements = 0;
2614:
2615: while(l_element_courant != NULL)
2616: {
2617: nombre_elements++;
2618: l_element_courant = (*l_element_courant).suivant;
2619: }
2620:
2621: if (nombre_elements == 3)
2622: {
2623: free(tampon);
2624:
2625: (*s_objet).type = (*(*(*l_base_liste_decomposition)
2626: .suivant).donnee).type;
2627: element = (void *) (*(*(*l_base_liste_decomposition)
2628: .suivant).donnee).objet;
2629:
2630: if ((*s_objet).type == NOM)
2631: {
2632: (*((struct_nom *) (*(*(*l_base_liste_decomposition)
2633: .suivant).donnee).objet)).symbole = d_vrai;
2634: }
2635: else if ((*s_objet).type == FCT)
2636: {
2637: /*
2638: * On essaye de mettre d'utiliser une fonction
2639: * comme un nom... On convertit la fonction en nom
2640: * puis on renvoie une erreur.
2641: */
2642:
2643: (*s_objet).type = NON;
2644: liberation(s_etat_processus, s_objet);
2645:
2646: l_element_courant = l_base_liste_decomposition;
2647:
2648: while(l_element_courant != NULL)
2649: {
2650: liberation(s_etat_processus,
2651: (*l_element_courant).donnee);
2652: l_element_precedent = l_element_courant;
2653: l_element_courant = (*l_element_courant).suivant;
2654: free(l_element_precedent);
2655: }
2656:
2657: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2658: (*s_etat_processus).traitement_interruptible =
2659: registre_interruption;
2660: return;
2661: }
2662:
2663: l_element_precedent = l_base_liste_decomposition;
2664: l_element_courant = (*l_element_precedent).suivant;
2665: liberation(s_etat_processus, (*l_element_precedent).donnee);
2666: free(l_element_precedent);
2667: l_element_precedent = l_element_courant;
2668: l_element_courant = (*l_element_courant).suivant;
2669: free((*l_element_precedent).donnee);
2670: free(l_element_precedent);
2671: liberation(s_etat_processus, (*l_element_courant).donnee);
2672: free(l_element_courant);
2673: }
2674: else
2675: {
2676: (*s_objet).type = ALG;
2677:
2678: if ((*s_etat_processus).debug == d_vrai)
2679: if (((*s_etat_processus).type_debug &
2680: d_debug_variables) != 0)
2681: {
2682: if ((*s_etat_processus).langue == 'F')
2683: {
2684: printf("[%d] Conversion de l'expression en "
2685: "notation polonaise inversée\n%s\n",
2686: (int) getpid(), tampon);
2687: }
2688: else
2689: {
2690: printf("[%d] Translation of expression "
2691: "into reverse polish notation\n%s",
2692: (int) getpid(), tampon);
2693: }
2694:
2695: fflush(stdout);
2696: }
2697:
2698: element = (void *) l_base_liste_decomposition;
2699: free(tampon);
2700:
2701: if (element == NULL)
2702: {
2703: (*s_etat_processus).erreur_execution =
2704: d_ex_expression_invalide;
2705: (*s_etat_processus).traitement_interruptible =
2706: registre_interruption;
2707: return;
2708: }
2709:
2710: l_element_courant = (struct_liste_chainee *) element;
2711:
2712: while(l_element_courant != NULL)
2713: {
2714: if ((*(*l_element_courant).donnee).type == FCT)
2715: {
2716: /*
2717: * Si la fonction est intrinsèque au langage,
2718: * elle est convertie en majuscules.
2719: */
2720:
2721: tampon = conversion_majuscule(s_etat_processus,
2722: (*((struct_fonction *)
2723: (*(*l_element_courant).donnee).objet))
2724: .nom_fonction);
2725:
2726: free((*((struct_fonction *)
2727: (*(*l_element_courant).donnee).objet))
2728: .nom_fonction);
2729:
2730: (*((struct_fonction *) (*(*l_element_courant).donnee)
2731: .objet)).nom_fonction = tampon;
2732:
2733: if (strcmp(tampon, "=") == 0)
2734: {
2735: nombre_egalites++;
2736: }
2737: }
2738:
2739: l_element_courant = (*l_element_courant).suivant;
2740: }
2741:
2742: l_element_courant = (struct_liste_chainee *) element;
2743:
2744: while(l_element_courant != NULL)
2745: {
2746: if (((*(*l_element_courant).donnee).type == FCT)
2747: || ((*(*l_element_courant).donnee).type == NOM))
2748: {
2749: if ((*(*l_element_courant).donnee).type == FCT)
2750: {
2751: if (l_base_liste_fonctions != NULL)
2752: {
2753: l_element_courant_fonctions =
2754: l_base_liste_fonctions;
2755:
2756: while(l_element_courant_fonctions != NULL)
2757: {
2758: if ((fonction_majuscule =
2759: conversion_majuscule(
2760: s_etat_processus,
2761: (*((struct_fonction *)
2762: ((*l_element_courant_fonctions)
2763: .donnee))).nom_fonction)) == NULL)
2764: {
2765: (*s_etat_processus).erreur_systeme =
2766: d_es_allocation_memoire;
2767: (*s_etat_processus)
2768: .traitement_interruptible =
2769: registre_interruption;
2770: return;
2771: }
2772:
2773: if (strcmp(fonction_majuscule,
2774: (*((struct_fonction *)
2775: (*(*l_element_courant).donnee)
2776: .objet)).nom_fonction) == 0)
2777: {
2778: free(fonction_majuscule);
2779: break;
2780: }
2781:
2782: free(fonction_majuscule);
2783: l_element_courant_fonctions =
2784: (*l_element_courant_fonctions)
2785: .suivant;
2786: }
2787:
2788: if (l_element_courant_fonctions != NULL)
2789: {
2790: (*((struct_fonction *)
2791: (*(*l_element_courant)
2792: .donnee).objet)).nombre_arguments =
2793: (*((struct_fonction *)
2794: ((*l_element_courant_fonctions)
2795: .donnee))).nombre_arguments;
2796: }
2797: else
2798: {
2799: (*((struct_fonction *)
2800: (*(*l_element_courant).donnee)
2801: .objet)).nombre_arguments = 0;
2802: }
2803: }
2804: else
2805: {
2806: (*((struct_fonction *)
2807: (*(*l_element_courant).donnee)
2808: .objet)).nombre_arguments = 0;
2809: }
2810: }
2811: else
2812: {
2813: (*((struct_nom *) (*(*l_element_courant).donnee)
2814: .objet)).symbole = d_faux;
2815:
2816: if (l_base_liste_fonctions != NULL)
2817: {
2818: l_element_courant_fonctions =
2819: l_base_liste_fonctions;
2820:
2821: while((strcmp((*((struct_fonction *)
2822: ((*l_element_courant_fonctions)
2823: .donnee))).nom_fonction,
2824: (*((struct_nom *)
2825: (*(*l_element_courant).donnee).objet))
2826: .nom) != 0) &&
2827: ((*l_element_courant_fonctions)
2828: .suivant != NULL))
2829: {
2830: l_element_courant_fonctions =
2831: (*l_element_courant_fonctions)
2832: .suivant;
2833: }
2834:
2835: if (((*l_element_courant_fonctions).suivant !=
2836: NULL) || (strcmp((*((struct_nom *)
2837: (*(*l_element_courant).donnee).objet))
2838: .nom, (*((struct_fonction *)
2839: ((*l_element_courant_fonctions)
2840: .donnee))).nom_fonction) == 0))
2841: {
2842: tampon = (*((struct_nom *)
2843: (*(*l_element_courant)
2844: .donnee).objet)).nom;
2845:
2846: if ((s_sous_objet = (struct_objet *)
2847: malloc(sizeof(
2848: struct_objet))) == NULL)
2849: {
2850: (*s_etat_processus).erreur_systeme =
2851: d_es_allocation_memoire;
2852: (*s_etat_processus)
2853: .traitement_interruptible =
2854: registre_interruption;
2855: return;
2856: }
2857:
2858: initialisation_objet(s_sous_objet);
2859: (*s_sous_objet).type = FCT;
2860:
2861: if (((*s_sous_objet).objet = (void *)
2862: malloc(sizeof(struct_fonction)))
2863: == NULL)
2864: {
2865: (*s_etat_processus).erreur_systeme =
2866: d_es_allocation_memoire;
2867: (*s_etat_processus)
2868: .traitement_interruptible =
2869: registre_interruption;
2870: return;
2871: }
2872:
2873: (*((struct_fonction *) ((*s_sous_objet)
2874: .objet))).nom_fonction = tampon;
2875:
2876: (*((struct_fonction *) ((*s_sous_objet)
2877: .objet))).fonction =
2878: analyse_instruction(
2879: s_etat_processus, tampon);
2880:
2881: (*((struct_fonction *) ((*s_sous_objet)
2882: .objet))).nombre_arguments =
2883: (*((struct_fonction *)
2884: ((*l_element_courant_fonctions)
2885: .donnee))).nombre_arguments;
2886:
2887: free((struct_nom *) (*(*l_element_courant)
2888: .donnee).objet);
2889: free((*l_element_courant).donnee);
2890:
2891: (*l_element_courant).donnee = s_sous_objet;
2892: }
2893: }
2894: }
2895: }
2896:
2897: l_element_courant = (*l_element_courant).suivant;
2898: }
2899: }
2900:
2901: while(l_base_liste_fonctions != NULL)
2902: {
2903: l_element_courant_fonctions = l_base_liste_fonctions;
2904: l_base_liste_fonctions = (*l_base_liste_fonctions).suivant;
2905:
2906: free((*((struct_fonction *) (*l_element_courant_fonctions)
2907: .donnee)).nom_fonction);
2908: free((struct_fonction *) (*l_element_courant_fonctions).donnee);
2909: free(l_element_courant_fonctions);
2910: }
2911:
2912: (*s_etat_processus).autorisation_empilement_programme = 'Y';
2913: break;
2914: }
2915:
2916: /*
2917: --------------------------------------------------------------------------------
2918: Chaîne de caractères
2919: --------------------------------------------------------------------------------
2920: */
2921:
2922: case '"' :
2923: {
2924: (*s_objet).type = CHN;
2925:
2926: element = (void *) ((unsigned char *) malloc(
2927: (strlen((*s_etat_processus).instruction_courante) - 1)
2928: * sizeof(unsigned char)));
2929:
2930: if (element == NULL)
2931: {
2932: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2933: (*s_etat_processus).traitement_interruptible =
2934: registre_interruption;
2935: return;
2936: }
2937:
2938: ptr_lecture = (*s_etat_processus).instruction_courante + 1;
2939: ptr_ecriture = (unsigned char *) element;
2940:
2941: while((*ptr_lecture) != d_code_fin_chaine)
2942: {
2943: *ptr_ecriture++ = *ptr_lecture++;
2944: }
2945:
2946: (*(--ptr_ecriture)) = d_code_fin_chaine;
2947:
2948: if (validation_chaine((unsigned char *) element) == d_faux)
2949: {
2950: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2951: (*s_etat_processus).traitement_interruptible =
2952: registre_interruption;
2953:
2954: free(element);
2955: return;
2956: }
2957:
2958: break;
2959: }
2960:
2961: /*
2962: --------------------------------------------------------------------------------
2963: Définition ou tableau
2964: --------------------------------------------------------------------------------
2965: */
2966:
2967: case '<' :
2968: {
2969: if ((*s_etat_processus).instruction_courante[1] == '[')
2970: {
2971: // Tableau
2972:
2973: (*s_etat_processus).type_en_cours = TBL;
2974: sauvegarde_longueur_definitions_chainees =
2975: (*s_etat_processus).longueur_definitions_chainees;
2976:
2977: tampon = (unsigned char *) malloc(((size_t)
2978: (((*s_etat_processus).longueur_definitions_chainees
2979: = (integer8) strlen((*s_etat_processus)
2980: .instruction_courante) + 2) + 1)) *
2981: sizeof(unsigned char));
2982:
2983: if (tampon == NULL)
2984: {
2985: (*s_etat_processus).erreur_systeme =
2986: d_es_allocation_memoire;
2987: (*s_etat_processus).traitement_interruptible =
2988: registre_interruption;
2989: return;
2990: }
2991:
2992: strcpy(tampon, "<< ");
2993: ptr_ecriture = tampon + 3;
2994: ptr_lecture = (*s_etat_processus).instruction_courante + 2;
2995:
2996: while((*ptr_lecture) != d_code_fin_chaine)
2997: {
2998: *ptr_ecriture++ = *ptr_lecture++;
2999: }
3000:
3001: ptr_ecriture -= 2;
3002: (*ptr_ecriture) = d_code_fin_chaine;
3003: strcat(ptr_ecriture, " >>");
3004:
3005: position_courante = (*s_etat_processus).position_courante;
3006: (*s_etat_processus).position_courante = 0;
3007:
3008: profondeur_initiale = (*s_etat_processus)
3009: .hauteur_pile_operationnelle;
3010:
3011: /*
3012: -- On met les éléments du tableau dans la pile opérationnelle ------------------
3013: */
3014:
3015: (*s_etat_processus).niveau_recursivite++;
3016: definitions_chainees_precedentes = (*s_etat_processus)
3017: .definitions_chainees;
3018: (*s_etat_processus).definitions_chainees = tampon;
3019:
3020: s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
3021: sauvegarde_niveau_courant = (*s_etat_processus).niveau_courant;
3022:
3023: (*s_etat_processus).l_base_pile_systeme = NULL;
3024: empilement_pile_systeme(s_etat_processus);
3025:
3026: if ((*s_etat_processus).erreur_systeme != d_es)
3027: {
3028: (*s_etat_processus).traitement_interruptible =
3029: registre_interruption;
3030: return;
3031: }
3032:
3033: (*(*s_etat_processus).l_base_pile_systeme)
3034: .retour_definition = 'Y';
3035: (*(*s_etat_processus).l_base_pile_systeme)
3036: .origine_routine_evaluation = 'N';
3037: (*s_etat_processus).niveau_courant = 0;
3038: (*s_etat_processus).autorisation_empilement_programme = 'N';
3039:
3040: tampon = (*s_etat_processus).instruction_courante;
3041: autorisation_evaluation_nom = (*s_etat_processus)
3042: .autorisation_evaluation_nom;
3043: (*s_etat_processus).autorisation_evaluation_nom = 'N';
3044:
3045: registre_mode_execution_programme =
3046: (*s_etat_processus).mode_execution_programme;
3047: (*s_etat_processus).mode_execution_programme = 'Y';
3048: (*s_etat_processus).erreur_scrutation = d_faux;
3049:
3050: nombre_lignes_a_supprimer =
3051: (*s_etat_processus).hauteur_pile_operationnelle;
3052:
3053: if ((*s_etat_processus).profilage == d_vrai)
3054: {
3055: profilage(s_etat_processus, "RPL/2 internals");
3056:
3057: if ((*s_etat_processus).erreur_systeme != d_es)
3058: {
3059: return;
3060: }
3061: }
3062:
3063: registre_recherche_type = (*s_etat_processus).recherche_type;
3064: (*s_etat_processus).recherche_type = 'Y';
3065:
3066: variable_implicite =
3067: (*s_etat_processus).autorisation_nom_implicite;
3068: (*s_etat_processus).autorisation_nom_implicite = 'Y';
3069:
3070: if (sequenceur(s_etat_processus) == d_erreur)
3071: {
3072: (*s_etat_processus).autorisation_nom_implicite =
3073: variable_implicite;
3074: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3075: (*s_etat_processus).recherche_type =
3076: registre_recherche_type;
3077: (*s_etat_processus).mode_execution_programme =
3078: registre_mode_execution_programme;
3079: nombre_lignes_a_supprimer =
3080: (*s_etat_processus).hauteur_pile_operationnelle
3081: - nombre_lignes_a_supprimer;
3082:
3083: for(i = 0; i < nombre_lignes_a_supprimer; i++)
3084: {
3085: if (depilement(s_etat_processus,
3086: &((*s_etat_processus).l_base_pile),
3087: &s_sous_objet) == d_erreur)
3088: {
3089: (*s_etat_processus).traitement_interruptible =
3090: registre_interruption;
3091: return;
3092: }
3093:
3094: liberation(s_etat_processus, s_sous_objet);
3095: }
3096:
3097: (*s_etat_processus).instruction_courante = tampon;
3098: (*s_etat_processus).autorisation_evaluation_nom =
3099: autorisation_evaluation_nom;
3100:
3101: effacement_pile_systeme(s_etat_processus);
3102: (*s_etat_processus).l_base_pile_systeme =
3103: s_sauvegarde_pile;
3104: (*s_etat_processus).niveau_courant =
3105: sauvegarde_niveau_courant;
3106:
3107: free((*s_etat_processus).definitions_chainees);
3108: (*s_etat_processus).niveau_recursivite--;
3109:
3110: (*s_etat_processus).definitions_chainees =
3111: definitions_chainees_precedentes;
3112: (*s_etat_processus).longueur_definitions_chainees =
3113: sauvegarde_longueur_definitions_chainees;
3114:
3115: (*s_etat_processus).position_courante =
3116: position_courante;
3117:
3118: liberation(s_etat_processus, s_objet);
3119:
3120: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3121: (*s_etat_processus).traitement_interruptible =
3122: registre_interruption;
3123: return;
3124: }
3125:
3126: (*s_etat_processus).autorisation_nom_implicite =
3127: variable_implicite;
3128: (*s_etat_processus).recherche_type = registre_recherche_type;
3129: (*s_etat_processus).mode_execution_programme =
3130: registre_mode_execution_programme;
3131:
3132: if ((*s_etat_processus).erreur_scrutation == d_vrai)
3133: {
3134: nombre_lignes_a_supprimer =
3135: (*s_etat_processus).hauteur_pile_operationnelle
3136: - nombre_lignes_a_supprimer;
3137:
3138: for(i = 0; i < nombre_lignes_a_supprimer; i++)
3139: {
3140: if (depilement(s_etat_processus,
3141: &((*s_etat_processus).l_base_pile),
3142: &s_sous_objet) == d_erreur)
3143: {
3144: (*s_etat_processus).traitement_interruptible =
3145: registre_interruption;
3146: return;
3147: }
3148:
3149: liberation(s_etat_processus, s_sous_objet);
3150: }
3151:
3152: (*s_etat_processus).instruction_courante = tampon;
3153: (*s_etat_processus).autorisation_evaluation_nom =
3154: autorisation_evaluation_nom;
3155:
3156: effacement_pile_systeme(s_etat_processus);
3157: (*s_etat_processus).l_base_pile_systeme =
3158: s_sauvegarde_pile;
3159: (*s_etat_processus).niveau_courant =
3160: sauvegarde_niveau_courant;
3161:
3162: free((*s_etat_processus).definitions_chainees);
3163: (*s_etat_processus).niveau_recursivite--;
3164:
3165: (*s_etat_processus).definitions_chainees =
3166: definitions_chainees_precedentes;
3167: (*s_etat_processus).longueur_definitions_chainees =
3168: sauvegarde_longueur_definitions_chainees;
3169:
3170: (*s_etat_processus).position_courante =
3171: position_courante;
3172:
3173: liberation(s_etat_processus, s_objet);
3174:
3175: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3176: (*s_etat_processus).traitement_interruptible =
3177: registre_interruption;
3178: return;
3179: }
3180:
3181: (*s_etat_processus).instruction_courante = tampon;
3182: (*s_etat_processus).autorisation_evaluation_nom =
3183: autorisation_evaluation_nom;
3184:
3185: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
3186: (*s_etat_processus).niveau_courant =
3187: sauvegarde_niveau_courant;
3188:
3189: free((*s_etat_processus).definitions_chainees);
3190: (*s_etat_processus).definitions_chainees =
3191: definitions_chainees_precedentes;
3192: (*s_etat_processus).longueur_definitions_chainees =
3193: sauvegarde_longueur_definitions_chainees;
3194:
3195: (*s_etat_processus).niveau_recursivite--;
3196:
3197: (*s_etat_processus).position_courante = position_courante;
3198:
3199: /*
3200: -- On relit la pile qui contient des sous-objets contenant les -----------------
3201: -- éléments du tableau ---------------------------------------------------------
3202: */
3203:
3204: profondeur_finale = (*s_etat_processus)
3205: .hauteur_pile_operationnelle;
3206:
3207: nombre_lignes = profondeur_finale - profondeur_initiale;
3208:
3209: if ((element = malloc(sizeof(struct_tableau))) == NULL)
3210: {
3211: (*s_etat_processus).erreur_systeme =
3212: d_es_allocation_memoire;
3213: (*s_etat_processus).traitement_interruptible =
3214: registre_interruption;
3215: return;
3216: }
3217:
3218: (*((struct_tableau *) element)).nombre_elements = nombre_lignes;
3219:
3220: if (((*((struct_tableau *) element)).elements =
3221: malloc(((size_t) nombre_lignes) *
3222: sizeof(struct_objet *))) == NULL)
3223: {
3224: (*s_etat_processus).erreur_systeme =
3225: d_es_allocation_memoire;
3226: (*s_etat_processus).traitement_interruptible =
3227: registre_interruption;
3228: return;
3229: }
3230:
3231: for(i = 1; i <= nombre_lignes; i++)
3232: {
3233: if (depilement(s_etat_processus,
3234: &((*s_etat_processus).l_base_pile),
3235: &s_sous_objet) == d_erreur)
3236: {
3237: (*s_etat_processus).traitement_interruptible =
3238: registre_interruption;
3239: return;
3240: }
3241:
3242: (*((struct_tableau *) element)).elements[nombre_lignes - i]
3243: = s_sous_objet;
3244: }
3245:
3246: (*s_objet).type = TBL;
3247:
3248: (*s_etat_processus).traitement_interruptible =
3249: registre_interruption;
3250: }
3251: else
3252: {
3253: // Définition
3254:
3255: (*s_etat_processus).type_en_cours = RPN;
3256:
3257: if (strlen((*s_etat_processus).instruction_courante) < 5)
3258: {
3259: liberation(s_etat_processus, s_objet);
3260:
3261: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3262: (*s_etat_processus).traitement_interruptible =
3263: registre_interruption;
3264: return;
3265: }
3266:
3267: if ((strncmp((*s_etat_processus).instruction_courante, "<< ", 3)
3268: != 0) && (strcmp((*s_etat_processus)
3269: .instruction_courante, "<<") != 0))
3270: {
3271: liberation(s_etat_processus, s_objet);
3272:
3273: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3274: (*s_etat_processus).traitement_interruptible =
3275: registre_interruption;
3276: return;
3277: }
3278:
3279: (*s_objet).type = RPN;
3280:
3281: element = (void *) analyse_rpn(s_etat_processus,
3282: (*s_etat_processus).instruction_courante);
3283:
3284: if (element == NULL)
3285: {
3286: if ((*s_etat_processus).erreur_systeme != d_es)
3287: {
3288: (*s_etat_processus).erreur_systeme =
3289: d_es_allocation_memoire;
3290: }
3291:
3292: liberation(s_etat_processus, s_objet);
3293:
3294: (*s_etat_processus).traitement_interruptible =
3295: registre_interruption;
3296: return;
3297: }
3298:
3299: l_element_courant = (struct_liste_chainee *) element;
3300:
3301: while(l_element_courant != NULL)
3302: {
3303: if ((*(*l_element_courant).donnee).type == FCT)
3304: {
3305: if (strcmp((*((struct_fonction *) (*(*l_element_courant)
3306: .donnee).objet)).nom_fonction, "=") == 0)
3307: {
3308: nombre_egalites++;
3309: }
3310: }
3311:
3312: l_element_courant = (*l_element_courant).suivant;
3313: }
3314: }
3315:
3316: break;
3317: }
3318:
3319: /*
3320: --------------------------------------------------------------------------------
3321: Entier ou réel
3322: --------------------------------------------------------------------------------
3323: */
3324:
3325: default :
3326: {
3327: if (((*((*s_etat_processus).instruction_courante)) == '-') ||
3328: ((*((*s_etat_processus).instruction_courante)) == '+') ||
3329: (((*((*s_etat_processus).instruction_courante)) >= '0') &&
3330: ((*((*s_etat_processus).instruction_courante))
3331: <= '9')) || ((*((*s_etat_processus).instruction_courante))
3332: == '.'))
3333: {
3334: drapeau_valeur_entiere = ((*((*s_etat_processus)
3335: .instruction_courante)) != '.') ? d_vrai : d_faux;
3336: drapeau_valeur_reelle = d_vrai;
3337:
3338: nombre_points = 0;
3339: nombre_exposants = 0;
3340:
3341: conversion_format(s_etat_processus,
3342: (*s_etat_processus).instruction_courante);
3343:
3344: ptr = (*s_etat_processus).instruction_courante;
3345:
3346: while((*ptr) != d_code_fin_chaine)
3347: {
3348: switch(*ptr)
3349: {
3350: case '0' :
3351: case '1' :
3352: case '2' :
3353: case '3' :
3354: case '4' :
3355: case '5' :
3356: case '6' :
3357: case '7' :
3358: case '8' :
3359: case '9' :
3360: {
3361: break;
3362: }
3363:
3364: // Ne peut survenir qu'après un 'E', un 'e' ou au
3365: // début de la chaîne.
3366: case '+' :
3367: case '-' :
3368: {
3369: if (ptr > (*s_etat_processus).instruction_courante)
3370: {
3371: if (((*(ptr - 1)) != 'e') &&
3372: ((*(ptr - 1)) != 'E'))
3373: {
3374: drapeau_valeur_entiere = d_faux;
3375: drapeau_valeur_reelle = d_faux;
3376: }
3377: }
3378:
3379: break;
3380: }
3381:
3382: // Ne peut que commencer une chaîne, suivre un
3383: // chiffre ou un signe. Ne peut constituer un
3384: // nombre seul.
3385: case '.' :
3386: {
3387: nombre_points++;
3388:
3389: if (ptr > (*s_etat_processus).instruction_courante)
3390: {
3391: switch(*(ptr - 1))
3392: {
3393: case '+' :
3394: case '-' :
3395: case '0' :
3396: case '1' :
3397: case '2' :
3398: case '3' :
3399: case '4' :
3400: case '5' :
3401: case '6' :
3402: case '7' :
3403: case '8' :
3404: case '9' :
3405: {
3406: drapeau_valeur_entiere = d_faux;
3407: break;
3408: }
3409:
3410: default :
3411: {
3412: drapeau_valeur_entiere = d_faux;
3413: drapeau_valeur_reelle = d_faux;
3414: break;
3415: }
3416: }
3417: }
3418: else
3419: {
3420: if ((*(ptr + 1)) == d_code_fin_chaine)
3421: {
3422: drapeau_valeur_entiere = d_faux;
3423: drapeau_valeur_reelle = d_faux;
3424: }
3425: }
3426:
3427: break;
3428: }
3429:
3430: // Ne peut suivre qu'un chiffre ou un point
3431: case 'e' :
3432: case 'E' :
3433: {
3434: nombre_exposants++;
3435:
3436: if (ptr > (*s_etat_processus).instruction_courante)
3437: {
3438: switch(*(ptr - 1))
3439: {
3440: case '0' :
3441: case '1' :
3442: case '2' :
3443: case '3' :
3444: case '4' :
3445: case '5' :
3446: case '6' :
3447: case '7' :
3448: case '8' :
3449: case '9' :
3450: {
3451: drapeau_valeur_entiere = d_faux;
3452: break;
3453: }
3454:
3455: // Le point doit suivre un chiffre
3456: case '.' :
3457: {
3458: if ((ptr - 1) > (*s_etat_processus)
3459: .instruction_courante)
3460: {
3461: switch(*(ptr - 2))
3462: {
3463: case '0' :
3464: case '1' :
3465: case '2' :
3466: case '3' :
3467: case '4' :
3468: case '5' :
3469: case '6' :
3470: case '7' :
3471: case '8' :
3472: case '9' :
3473: {
3474: drapeau_valeur_entiere =
3475: d_faux;
3476: break;
3477: }
3478:
3479: default :
3480: {
3481: drapeau_valeur_entiere =
3482: d_faux;
3483: drapeau_valeur_reelle =
3484: d_faux;
3485: break;
3486: }
3487: }
3488: }
3489: else
3490: {
3491: drapeau_valeur_entiere = d_faux;
3492: drapeau_valeur_reelle = d_faux;
3493: }
3494:
3495: break;
3496: }
3497:
3498: default :
3499: {
3500: drapeau_valeur_entiere = d_faux;
3501: drapeau_valeur_reelle = d_faux;
3502: break;
3503: }
3504: }
3505: }
3506: else
3507: {
3508: drapeau_valeur_entiere = d_faux;
3509: drapeau_valeur_reelle = d_faux;
3510: }
3511:
3512: break;
3513: }
3514:
3515: default :
3516: {
3517: drapeau_valeur_entiere = d_faux;
3518: drapeau_valeur_reelle = d_faux;
3519: break;
3520: }
3521: }
3522:
3523: ptr++;
3524: }
3525:
3526: if ((nombre_points > 1) || (nombre_exposants > 1))
3527: {
3528: drapeau_valeur_reelle = d_faux;
3529: drapeau_valeur_entiere = d_faux;
3530: }
3531: }
3532: else
3533: {
3534: drapeau_valeur_entiere = d_faux;
3535: drapeau_valeur_reelle = d_faux;
3536: }
3537:
3538: if ((drapeau_valeur_reelle == d_faux) &&
3539: (drapeau_valeur_entiere == d_faux))
3540: {
3541: ptr = (*s_etat_processus).instruction_courante;
3542:
3543: while((*ptr) != d_code_fin_chaine)
3544: {
3545: if (isalnum(*ptr) != 0)
3546: {
3547: ptr++;
3548: }
3549: else if (((*ptr) == '_') || ((*ptr == '$')))
3550: {
3551: ptr++;
3552: }
3553: else
3554: {
3555: liberation(s_etat_processus, s_objet);
3556:
3557: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3558: (*s_etat_processus).traitement_interruptible =
3559: registre_interruption;
3560: return;
3561: }
3562: }
3563:
3564: (*s_objet).type = NOM;
3565:
3566: element = malloc(sizeof(struct_nom));
3567:
3568: if (element == NULL)
3569: {
3570: (*s_etat_processus).erreur_systeme =
3571: d_es_allocation_memoire;
3572: (*s_etat_processus).traitement_interruptible =
3573: registre_interruption;
3574: return;
3575: }
3576:
3577: (*((struct_nom *) element)).symbole = d_faux;
3578: (*((struct_nom *) element)).nom = ((unsigned char *) malloc(
3579: (strlen((*s_etat_processus)
3580: .instruction_courante) + 1) * sizeof(unsigned char)));
3581:
3582: if ((*((struct_nom *) element)).nom == NULL)
3583: {
3584: (*s_etat_processus).erreur_systeme =
3585: d_es_allocation_memoire;
3586: (*s_etat_processus).traitement_interruptible =
3587: registre_interruption;
3588: return;
3589: }
3590:
3591: strcpy((*((struct_nom *) element)).nom, (*s_etat_processus)
3592: .instruction_courante);
3593: }
3594: else
3595: {
3596: if (drapeau_valeur_entiere == d_faux)
3597: {
3598: (*s_objet).type = REL;
3599:
3600: element = (void *) ((real8 *) malloc(
3601: sizeof(real8)));
3602:
3603: if (element == NULL)
3604: {
3605: (*s_etat_processus).erreur_systeme =
3606: d_es_allocation_memoire;
3607: (*s_etat_processus).traitement_interruptible =
3608: registre_interruption;
3609: return;
3610: }
3611:
3612: nombre_elements_convertis = sscanf(
3613: (*s_etat_processus).instruction_courante, "%lg",
3614: (real8 *) element);
3615:
3616: if (nombre_elements_convertis != 1)
3617: {
3618: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3619: }
3620: }
3621: else
3622: {
3623: // Le format ressemble à un entier mais il peut y avoir
3624: // un dépassement de capacité lors de la conversion.
3625: // On convertit donc en entier et en réel. Si les
3626: // deux conversions donnent le même résultat, on
3627: // considère que la conversion en entier est bonne. Dans
3628: // le cas contraire, on garde la conversion en réel.
3629:
3630: integer8 conversion_entiere;
3631: real8 conversion_reelle;
3632:
3633: if (sscanf((*s_etat_processus).instruction_courante, "%lld",
3634: &conversion_entiere) != 1)
3635: {
3636: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3637: }
3638:
3639: if (errno != ERANGE)
3640: {
3641: (*s_objet).type = INT;
3642:
3643: element = malloc(sizeof(integer8));
3644:
3645: if (element == NULL)
3646: {
3647: (*s_etat_processus).erreur_systeme =
3648: d_es_allocation_memoire;
3649: (*s_etat_processus).traitement_interruptible =
3650: registre_interruption;
3651: return;
3652: }
3653:
3654: (*((integer8 *) element)) = conversion_entiere;
3655: }
3656: else
3657: {
3658: if (sscanf((*s_etat_processus).instruction_courante,
3659: "%lg", &conversion_reelle) != 1)
3660: {
3661: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3662: }
3663:
3664: (*s_objet).type = REL;
3665:
3666: element = malloc(sizeof(real8));
3667:
3668: if (element == NULL)
3669: {
3670: (*s_etat_processus).erreur_systeme =
3671: d_es_allocation_memoire;
3672: (*s_etat_processus).traitement_interruptible =
3673: registre_interruption;
3674: return;
3675: }
3676:
3677: (*((real8 *) element)) = conversion_reelle;
3678: }
3679: }
3680: }
3681:
3682: break;
3683: }
3684: }
3685:
3686: (*s_objet).objet = element;
3687:
3688: if (nombre_egalites > 1)
3689: {
3690: liberation(s_etat_processus, s_objet);
3691:
3692: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3693: (*s_etat_processus).traitement_interruptible = registre_interruption;
3694: return;
3695: }
3696:
3697: if (empilement(s_etat_processus,
3698: &((*s_etat_processus).l_base_pile), s_objet) == d_erreur)
3699: {
3700: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3701: (*s_etat_processus).traitement_interruptible =
3702: registre_interruption;
3703: return;
3704: }
3705:
3706: (*s_etat_processus).traitement_interruptible = registre_interruption;
3707: return;
3708: }
3709:
3710:
3711: /*
3712: ================================================================================
3713: Conversion de la virgule
3714: ================================================================================
3715: Entrées : structure sur l'état du processus
3716: --------------------------------------------------------------------------------
3717: Sorties : néant
3718: --------------------------------------------------------------------------------
3719: Effets de bord : néant
3720: ================================================================================
3721: */
3722:
3723: void
3724: conversion_format(struct_processus *s_etat_processus, unsigned char *chaine)
3725: {
3726: unsigned char *ptr;
3727:
3728: /*
3729: --------------------------------------------------------------------------------
3730: Transcription du point en virgule et réciproquement selon l'indicateur 48
3731: --------------------------------------------------------------------------------
3732: */
3733:
3734: if (test_cfsf(s_etat_processus, 48) == d_vrai)
3735: {
3736: ptr = chaine;
3737:
3738: while((*ptr) != d_code_fin_chaine)
3739: {
3740: if ((*ptr) == '.')
3741: {
3742: (*ptr) = ',';
3743: }
3744: else if ((*ptr) == ',')
3745: {
3746: (*ptr) = '.';
3747: }
3748:
3749: ptr++;
3750: }
3751: }
3752:
3753: return;
3754: }
3755:
3756: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to types.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src