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