![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to types.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src|
Return to types.c CVS log | Up to [local] / rpl / src |
1.1 bertrand 1: /*
2: ================================================================================
1.53 ! bertrand 3: RPL/2 (R) version 4.1.12
1.44 bertrand 4: Copyright (C) 1989-2012 Dr. BERTRAND Joël
1.1 bertrand 5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
1.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: {
2225: if (drapeau_chaine == d_faux)
2226: {
2227: drapeau_chaine = d_vrai;
2228: }
2229: else
2230: {
2231: drapeau_chaine = d_faux;
2232: }
2233: }
2234: else if (drapeau_chaine == d_faux)
2235: {
2236: if (((*s_etat_processus).definitions_chainees
2237: [(*s_etat_processus).position_courante] == '<') &&
2238: ((*s_etat_processus).definitions_chainees
2239: [(*s_etat_processus).position_courante + 1] == '<'))
2240: {
2241: coherence_liste++;
2242: }
2243: else if (((*s_etat_processus).definitions_chainees
2244: [(*s_etat_processus).position_courante] == '>') &&
2245: ((*s_etat_processus).definitions_chainees
2246: [(*s_etat_processus).position_courante + 1] == '>'))
2247: {
2248: coherence_liste--;
2249: }
2250:
2251: }
2252:
2253: (*s_etat_processus).position_courante++;
2254: }
2255:
2256: (*s_etat_processus).position_courante = 0;
2257:
2258: if ((coherence_liste != 0) || (drapeau_chaine == d_vrai))
2259: {
2260: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2261:
2262: nombre_lignes_a_supprimer =
2263: (*s_etat_processus).hauteur_pile_operationnelle
2264: - nombre_lignes_a_supprimer;
2265:
2266: for(i = 0; i < nombre_lignes_a_supprimer; i++)
2267: {
2268: if (depilement(s_etat_processus, &((*s_etat_processus)
2269: .l_base_pile), &s_sous_objet) == d_erreur)
2270: {
2271: (*s_etat_processus).traitement_interruptible =
2272: registre_interruption;
2273: (*s_etat_processus).mode_execution_programme =
2274: registre_mode_execution_programme;
2275: return;
2276: }
2277:
2278: liberation(s_etat_processus, s_sous_objet);
2279: }
2280:
2281: (*s_etat_processus).test_instruction = registre_test;
2282: (*s_etat_processus).longueur_definitions_chainees =
2283: sauvegarde_longueur_definitions_chainees;
2284:
2285: (*s_etat_processus).instruction_courante = tampon;
2286: (*s_etat_processus).autorisation_evaluation_nom =
2287: autorisation_evaluation_nom;
2288:
1.12 bertrand 2289: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 2290: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2291: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2292:
2293: free((*s_etat_processus).definitions_chainees);
1.47 bertrand 2294: liberation(s_etat_processus, s_objet);
1.1 bertrand 2295:
2296: (*s_etat_processus).definitions_chainees =
2297: definitions_chainees_precedentes;
2298:
2299: (*s_etat_processus).niveau_recursivite--;
2300:
2301: (*s_etat_processus).position_courante = position_courante;
2302:
2303: (*s_etat_processus).traitement_interruptible =
2304: registre_interruption;
2305: (*s_etat_processus).mode_execution_programme =
2306: registre_mode_execution_programme;
2307: return;
2308: }
2309:
2310: /*
2311: * Scrutation de la séquence.
2312: */
2313:
2314: (*s_etat_processus).position_courante = 0;
2315:
2316: if ((*s_etat_processus).profilage == d_vrai)
2317: {
2318: profilage(s_etat_processus, "RPL/2 internals");
2319:
2320: if ((*s_etat_processus).erreur_systeme != d_es)
2321: {
2322: return;
2323: }
2324: }
2325:
1.34 bertrand 2326: variable_implicite = (*s_etat_processus).autorisation_nom_implicite;
1.24 bertrand 2327: registre_recherche_type = (*s_etat_processus).recherche_type;
2328: (*s_etat_processus).recherche_type = 'Y';
1.34 bertrand 2329: (*s_etat_processus).autorisation_nom_implicite = 'Y';
1.24 bertrand 2330:
1.1 bertrand 2331: if (sequenceur(s_etat_processus) == d_erreur)
2332: {
1.34 bertrand 2333: (*s_etat_processus).autorisation_nom_implicite =
2334: variable_implicite;
1.24 bertrand 2335: (*s_etat_processus).recherche_type = registre_recherche_type;
1.1 bertrand 2336: (*s_etat_processus).mode_execution_programme =
2337: registre_mode_execution_programme;
1.34 bertrand 2338:
2339: if ((*s_etat_processus).erreur_execution !=
2340: d_ex_nom_implicite)
2341: {
2342: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2343: }
1.1 bertrand 2344:
2345: nombre_lignes_a_supprimer =
2346: (*s_etat_processus).hauteur_pile_operationnelle
2347: - nombre_lignes_a_supprimer;
2348:
2349: for(i = 0; i < nombre_lignes_a_supprimer; i++)
2350: {
2351: if (depilement(s_etat_processus, &((*s_etat_processus)
2352: .l_base_pile), &s_sous_objet) == d_erreur)
2353: {
2354: (*s_etat_processus).traitement_interruptible =
2355: registre_interruption;
2356: return;
2357: }
2358:
2359: liberation(s_etat_processus, s_sous_objet);
2360: }
2361:
2362: (*s_etat_processus).test_instruction = registre_test;
2363: (*s_etat_processus).longueur_definitions_chainees =
2364: sauvegarde_longueur_definitions_chainees;
2365:
2366: (*s_etat_processus).instruction_courante = tampon;
2367: (*s_etat_processus).autorisation_evaluation_nom =
2368: autorisation_evaluation_nom;
2369:
1.12 bertrand 2370: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 2371: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2372: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2373:
2374: free((*s_etat_processus).definitions_chainees);
1.47 bertrand 2375: liberation(s_etat_processus, s_objet);
1.1 bertrand 2376:
2377: (*s_etat_processus).definitions_chainees =
2378: definitions_chainees_precedentes;
2379:
2380: (*s_etat_processus).niveau_recursivite--;
2381:
2382: (*s_etat_processus).position_courante = position_courante;
2383:
2384: (*s_etat_processus).traitement_interruptible =
2385: registre_interruption;
2386: return;
2387: }
2388:
1.34 bertrand 2389: (*s_etat_processus).autorisation_nom_implicite = variable_implicite;
1.24 bertrand 2390: (*s_etat_processus).recherche_type = registre_recherche_type;
1.1 bertrand 2391: (*s_etat_processus).mode_execution_programme =
2392: registre_mode_execution_programme;
2393:
2394: if ((*s_etat_processus).erreur_scrutation == d_vrai)
2395: {
2396: nombre_lignes_a_supprimer =
2397: (*s_etat_processus).hauteur_pile_operationnelle
2398: - nombre_lignes_a_supprimer;
2399:
2400: for(i = 0; i < nombre_lignes_a_supprimer; i++)
2401: {
2402: if (depilement(s_etat_processus, &((*s_etat_processus)
2403: .l_base_pile), &s_sous_objet) == d_erreur)
2404: {
2405: (*s_etat_processus).traitement_interruptible =
2406: registre_interruption;
2407: return;
2408: }
2409:
2410: liberation(s_etat_processus, s_sous_objet);
2411: }
2412:
2413: (*s_etat_processus).test_instruction = registre_test;
2414: (*s_etat_processus).longueur_definitions_chainees =
2415: sauvegarde_longueur_definitions_chainees;
2416:
2417: (*s_etat_processus).instruction_courante = tampon;
2418: (*s_etat_processus).autorisation_evaluation_nom =
2419: autorisation_evaluation_nom;
2420:
1.12 bertrand 2421: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 2422: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2423: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2424:
2425: free((*s_etat_processus).definitions_chainees);
1.47 bertrand 2426: liberation(s_etat_processus, s_objet);
1.1 bertrand 2427:
2428: (*s_etat_processus).definitions_chainees =
2429: definitions_chainees_precedentes;
2430:
2431: (*s_etat_processus).niveau_recursivite--;
2432: (*s_etat_processus).position_courante = position_courante;
2433:
2434: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2435: (*s_etat_processus).traitement_interruptible =
2436: registre_interruption;
2437: return;
2438: }
2439:
2440: (*s_etat_processus).test_instruction = registre_test;
2441: (*s_etat_processus).longueur_definitions_chainees =
2442: sauvegarde_longueur_definitions_chainees;
2443:
2444: (*s_etat_processus).instruction_courante = tampon;
2445: (*s_etat_processus).autorisation_evaluation_nom =
2446: autorisation_evaluation_nom;
2447:
2448: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2449: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2450:
2451: free((*s_etat_processus).definitions_chainees);
2452: (*s_etat_processus).definitions_chainees =
2453: definitions_chainees_precedentes;
2454:
2455: (*s_etat_processus).niveau_recursivite--;
2456:
2457: (*s_etat_processus).position_courante = position_courante;
2458:
2459: /*
2460: -- Relecture de la pile opérationnelle -----------------------------------------
2461: */
2462:
2463: profondeur_finale = (*s_etat_processus).hauteur_pile_operationnelle;
2464:
2465: l_element_courant = NULL;
1.47 bertrand 2466: s_objet_registre = s_objet;
1.1 bertrand 2467:
2468: for(i = 0; i < (profondeur_finale - profondeur_initiale); i++)
2469: {
2470: if (depilement(s_etat_processus,
2471: &((*s_etat_processus).l_base_pile),
2472: &s_objet) == d_erreur)
2473: {
1.47 bertrand 2474: liberation(s_etat_processus, s_objet_registre);
1.1 bertrand 2475: (*s_etat_processus).traitement_interruptible =
2476: registre_interruption;
2477: return;
2478: }
2479:
2480: if (empilement(s_etat_processus, &l_element_courant,
2481: s_objet) == d_erreur)
2482: {
1.47 bertrand 2483: liberation(s_etat_processus, s_objet_registre);
1.1 bertrand 2484: (*s_etat_processus).traitement_interruptible =
2485: registre_interruption;
2486: return;
2487: }
2488: }
2489:
1.47 bertrand 2490: s_objet = s_objet_registre;
1.1 bertrand 2491: (*s_objet).type = LST;
2492: element = (void *) l_element_courant;
2493:
2494: break;
2495: }
2496:
2497: /*
2498: --------------------------------------------------------------------------------
2499: Nom ou expression algébrique
2500: --------------------------------------------------------------------------------
2501: */
2502:
2503: case '\'' :
2504: {
2505: if ((tampon = analyse_algebrique(s_etat_processus,
2506: (*s_etat_processus).instruction_courante,
2507: &l_base_liste_fonctions)) == NULL)
2508: {
2509: /*
2510: * L'erreur est de type exécution ou système.
2511: * Dans le doute, on libère *s_objet.
2512: */
2513:
2514: while(l_base_liste_fonctions != NULL)
2515: {
2516: l_element_courant_fonctions = l_base_liste_fonctions;
2517: l_base_liste_fonctions = (*l_base_liste_fonctions).suivant;
2518:
2519: free((*((struct_fonction *) (*l_element_courant_fonctions)
2520: .donnee)).nom_fonction);
2521: free((struct_fonction *) (*l_element_courant_fonctions)
2522: .donnee);
2523: free(l_element_courant_fonctions);
2524: }
2525:
1.47 bertrand 2526: liberation(s_etat_processus, s_objet);
1.1 bertrand 2527:
2528: (*s_etat_processus).traitement_interruptible =
2529: registre_interruption;
2530: return;
2531: }
2532:
2533: l_base_liste_decomposition = analyse_rpn(s_etat_processus, tampon);
2534: l_element_courant = l_base_liste_decomposition;
2535: nombre_elements = 0;
2536:
2537: while(l_element_courant != NULL)
2538: {
2539: nombre_elements++;
2540: l_element_courant = (*l_element_courant).suivant;
2541: }
2542:
2543: if (nombre_elements == 3)
2544: {
2545: free(tampon);
2546:
2547: (*s_objet).type = (*(*(*l_base_liste_decomposition)
2548: .suivant).donnee).type;
2549: element = (void *) (*(*(*l_base_liste_decomposition)
2550: .suivant).donnee).objet;
2551:
2552: if ((*s_objet).type == NOM)
2553: {
2554: (*((struct_nom *) (*(*(*l_base_liste_decomposition)
2555: .suivant).donnee).objet)).symbole = d_vrai;
2556: }
2557: else if ((*s_objet).type == FCT)
2558: {
2559: /*
2560: * On essaye de mettre d'utiliser une fonction
2561: * comme un nom... On convertit la fonction en nom
2562: * puis on renvoie une erreur.
2563: */
2564:
1.47 bertrand 2565: (*s_objet).type = NON;
2566: liberation(s_etat_processus, s_objet);
1.1 bertrand 2567:
2568: l_element_courant = l_base_liste_decomposition;
2569:
2570: while(l_element_courant != NULL)
2571: {
2572: liberation(s_etat_processus,
2573: (*l_element_courant).donnee);
2574: l_element_precedent = l_element_courant;
2575: l_element_courant = (*l_element_courant).suivant;
2576: free(l_element_precedent);
2577: }
2578:
2579: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2580: (*s_etat_processus).traitement_interruptible =
2581: registre_interruption;
2582: return;
2583: }
2584:
2585: l_element_precedent = l_base_liste_decomposition;
2586: l_element_courant = (*l_element_precedent).suivant;
2587: liberation(s_etat_processus, (*l_element_precedent).donnee);
2588: free(l_element_precedent);
2589: l_element_precedent = l_element_courant;
2590: l_element_courant = (*l_element_courant).suivant;
2591: free((*l_element_precedent).donnee);
2592: free(l_element_precedent);
2593: liberation(s_etat_processus, (*l_element_courant).donnee);
2594: free(l_element_courant);
2595: }
2596: else
2597: {
2598: (*s_objet).type = ALG;
2599:
2600: if ((*s_etat_processus).debug == d_vrai)
2601: if (((*s_etat_processus).type_debug &
2602: d_debug_variables) != 0)
2603: {
2604: if ((*s_etat_processus).langue == 'F')
2605: {
2606: printf("[%d] Conversion de l'expression en "
2607: "notation polonaise inversée\n%s\n",
2608: (int) getpid(), tampon);
2609: }
2610: else
2611: {
2612: printf("[%d] Translation of expression "
2613: "into reverse polish notation\n%s",
2614: (int) getpid(), tampon);
2615: }
2616:
2617: fflush(stdout);
2618: }
2619:
2620: element = (void *) l_base_liste_decomposition;
2621: free(tampon);
2622:
2623: if (element == NULL)
2624: {
2625: (*s_etat_processus).erreur_execution =
2626: d_ex_expression_invalide;
2627: (*s_etat_processus).traitement_interruptible =
2628: registre_interruption;
2629: return;
2630: }
2631:
2632: l_element_courant = (struct_liste_chainee *) element;
2633:
2634: while(l_element_courant != NULL)
2635: {
2636: if ((*(*l_element_courant).donnee).type == FCT)
2637: {
2638: /*
2639: * Si la fonction est intrinsèque au langage,
2640: * elle est convertie en majuscules.
2641: */
2642:
2643: tampon = conversion_majuscule((*((struct_fonction *)
2644: (*(*l_element_courant).donnee).objet))
2645: .nom_fonction);
2646:
2647: free((*((struct_fonction *)
2648: (*(*l_element_courant).donnee).objet))
2649: .nom_fonction);
2650:
2651: (*((struct_fonction *) (*(*l_element_courant).donnee)
2652: .objet)).nom_fonction = tampon;
2653:
2654: if (strcmp(tampon, "=") == 0)
2655: {
2656: nombre_egalites++;
2657: }
2658: }
2659:
2660: l_element_courant = (*l_element_courant).suivant;
2661: }
2662:
2663: l_element_courant = (struct_liste_chainee *) element;
2664:
2665: while(l_element_courant != NULL)
2666: {
2667: if (((*(*l_element_courant).donnee).type == FCT)
2668: || ((*(*l_element_courant).donnee).type == NOM))
2669: {
2670: if ((*(*l_element_courant).donnee).type == FCT)
2671: {
2672: if (l_base_liste_fonctions != NULL)
2673: {
2674: l_element_courant_fonctions =
2675: l_base_liste_fonctions;
2676:
2677: while(l_element_courant_fonctions != NULL)
2678: {
2679: if ((fonction_majuscule =
2680: conversion_majuscule(
2681: (*((struct_fonction *)
2682: ((*l_element_courant_fonctions)
2683: .donnee))).nom_fonction)) == NULL)
2684: {
2685: (*s_etat_processus).erreur_systeme =
2686: d_es_allocation_memoire;
2687: (*s_etat_processus)
2688: .traitement_interruptible =
2689: registre_interruption;
2690: return;
2691: }
2692:
2693: if (strcmp(fonction_majuscule,
2694: (*((struct_fonction *)
2695: (*(*l_element_courant).donnee)
2696: .objet)).nom_fonction) == 0)
2697: {
2698: free(fonction_majuscule);
2699: break;
2700: }
2701:
2702: free(fonction_majuscule);
2703: l_element_courant_fonctions =
2704: (*l_element_courant_fonctions)
2705: .suivant;
2706: }
2707:
2708: if (l_element_courant_fonctions != NULL)
2709: {
2710: (*((struct_fonction *)
2711: (*(*l_element_courant)
2712: .donnee).objet)).nombre_arguments =
2713: (*((struct_fonction *)
2714: ((*l_element_courant_fonctions)
2715: .donnee))).nombre_arguments;
2716: }
2717: else
2718: {
2719: (*((struct_fonction *)
2720: (*(*l_element_courant).donnee)
2721: .objet)).nombre_arguments = 0;
2722: }
2723: }
2724: else
2725: {
2726: (*((struct_fonction *)
2727: (*(*l_element_courant).donnee)
2728: .objet)).nombre_arguments = 0;
2729: }
2730: }
2731: else
2732: {
2733: (*((struct_nom *) (*(*l_element_courant).donnee)
2734: .objet)).symbole = d_faux;
2735:
2736: if (l_base_liste_fonctions != NULL)
2737: {
2738: l_element_courant_fonctions =
2739: l_base_liste_fonctions;
2740:
2741: while((strcmp((*((struct_fonction *)
2742: ((*l_element_courant_fonctions)
2743: .donnee))).nom_fonction,
2744: (*((struct_nom *)
2745: (*(*l_element_courant).donnee).objet))
2746: .nom) != 0) &&
2747: ((*l_element_courant_fonctions)
2748: .suivant != NULL))
2749: {
2750: l_element_courant_fonctions =
2751: (*l_element_courant_fonctions)
2752: .suivant;
2753: }
2754:
2755: if (((*l_element_courant_fonctions).suivant !=
2756: NULL) || (strcmp((*((struct_nom *)
2757: (*(*l_element_courant).donnee).objet))
2758: .nom, (*((struct_fonction *)
2759: ((*l_element_courant_fonctions)
2760: .donnee))).nom_fonction) == 0))
2761: {
2762: tampon = (*((struct_nom *)
2763: (*(*l_element_courant)
2764: .donnee).objet)).nom;
2765:
2766: if ((s_sous_objet = (struct_objet *)
2767: malloc(sizeof(
2768: struct_objet))) == NULL)
2769: {
2770: (*s_etat_processus).erreur_systeme =
2771: d_es_allocation_memoire;
2772: (*s_etat_processus)
2773: .traitement_interruptible =
2774: registre_interruption;
2775: return;
2776: }
2777:
2778: initialisation_objet(s_sous_objet);
2779: (*s_sous_objet).type = FCT;
2780:
2781: if (((*s_sous_objet).objet = (void *)
1.8 bertrand 2782: malloc(sizeof(struct_fonction)))
1.1 bertrand 2783: == NULL)
2784: {
2785: (*s_etat_processus).erreur_systeme =
2786: d_es_allocation_memoire;
2787: (*s_etat_processus)
2788: .traitement_interruptible =
2789: registre_interruption;
2790: return;
2791: }
2792:
2793: (*((struct_fonction *) ((*s_sous_objet)
2794: .objet))).nom_fonction = tampon;
2795:
2796: (*((struct_fonction *) ((*s_sous_objet)
2797: .objet))).fonction =
2798: analyse_instruction(
2799: s_etat_processus, tampon);
2800:
2801: (*((struct_fonction *) ((*s_sous_objet)
2802: .objet))).nombre_arguments =
2803: (*((struct_fonction *)
2804: ((*l_element_courant_fonctions)
2805: .donnee))).nombre_arguments;
2806:
2807: free((struct_nom *) (*(*l_element_courant)
2808: .donnee).objet);
2809: free((*l_element_courant).donnee);
2810:
2811: (*l_element_courant).donnee = s_sous_objet;
2812: }
2813: }
2814: }
2815: }
2816:
2817: l_element_courant = (*l_element_courant).suivant;
2818: }
2819: }
2820:
2821: while(l_base_liste_fonctions != NULL)
2822: {
2823: l_element_courant_fonctions = l_base_liste_fonctions;
2824: l_base_liste_fonctions = (*l_base_liste_fonctions).suivant;
2825:
2826: free((*((struct_fonction *) (*l_element_courant_fonctions)
2827: .donnee)).nom_fonction);
2828: free((struct_fonction *) (*l_element_courant_fonctions).donnee);
2829: free(l_element_courant_fonctions);
2830: }
2831:
2832: break;
2833: }
2834:
2835: /*
2836: --------------------------------------------------------------------------------
2837: Chaîne de caractères
2838: --------------------------------------------------------------------------------
2839: */
2840:
2841: case '"' :
2842: {
2843: (*s_objet).type = CHN;
2844:
2845: element = (void *) ((unsigned char *) malloc(
2846: (strlen((*s_etat_processus).instruction_courante) - 1)
2847: * sizeof(unsigned char)));
2848:
2849: if (element == NULL)
2850: {
2851: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2852: (*s_etat_processus).traitement_interruptible =
2853: registre_interruption;
2854: return;
2855: }
2856:
2857: ptr_lecture = (*s_etat_processus).instruction_courante + 1;
2858: ptr_ecriture = (unsigned char *) element;
2859:
2860: while((*ptr_lecture) != d_code_fin_chaine)
2861: {
2862: *ptr_ecriture++ = *ptr_lecture++;
2863: }
2864:
2865: (*(--ptr_ecriture)) = d_code_fin_chaine;
2866:
1.41 bertrand 2867: if (validation_chaine((unsigned char *) element) == d_faux)
2868: {
2869: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2870: (*s_etat_processus).traitement_interruptible =
2871: registre_interruption;
2872:
2873: free(element);
2874: return;
2875: }
2876:
1.1 bertrand 2877: break;
2878: }
2879:
2880: /*
2881: --------------------------------------------------------------------------------
2882: Définition ou tableau
2883: --------------------------------------------------------------------------------
2884: */
2885:
2886: case '<' :
2887: {
2888: if ((*s_etat_processus).instruction_courante[1] == '[')
2889: {
2890: // Tableau
2891:
2892: sauvegarde_longueur_definitions_chainees =
2893: (*s_etat_processus).longueur_definitions_chainees;
2894:
2895: tampon = (unsigned char *) malloc(
2896: (((*s_etat_processus).longueur_definitions_chainees
2897: = strlen((*s_etat_processus).instruction_courante)
2898: + 2) + 1) * sizeof(unsigned char));
2899:
2900: if (tampon == NULL)
2901: {
2902: (*s_etat_processus).erreur_systeme =
2903: d_es_allocation_memoire;
2904: (*s_etat_processus).traitement_interruptible =
2905: registre_interruption;
2906: return;
2907: }
2908:
2909: strcpy(tampon, "<< ");
2910: ptr_ecriture = tampon + 3;
2911: ptr_lecture = (*s_etat_processus).instruction_courante + 2;
2912:
2913: while((*ptr_lecture) != d_code_fin_chaine)
2914: {
2915: *ptr_ecriture++ = *ptr_lecture++;
2916: }
2917:
2918: ptr_ecriture -= 2;
2919: (*ptr_ecriture) = d_code_fin_chaine;
2920: strcat(ptr_ecriture, " >>");
2921:
2922: position_courante = (*s_etat_processus).position_courante;
2923: (*s_etat_processus).position_courante = 0;
2924:
2925: profondeur_initiale = (*s_etat_processus)
2926: .hauteur_pile_operationnelle;
2927:
2928: /*
2929: -- On met les éléments du tableau dans la pile opérationnelle ------------------
2930: */
2931:
2932: (*s_etat_processus).niveau_recursivite++;
2933: definitions_chainees_precedentes = (*s_etat_processus)
2934: .definitions_chainees;
2935: (*s_etat_processus).definitions_chainees = tampon;
2936:
2937: s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
2938: sauvegarde_niveau_courant = (*s_etat_processus).niveau_courant;
2939:
2940: (*s_etat_processus).l_base_pile_systeme = NULL;
2941: empilement_pile_systeme(s_etat_processus);
2942:
2943: if ((*s_etat_processus).erreur_systeme != d_es)
2944: {
2945: (*s_etat_processus).traitement_interruptible =
2946: registre_interruption;
2947: return;
2948: }
2949:
2950: (*(*s_etat_processus).l_base_pile_systeme)
2951: .retour_definition = 'Y';
2952: (*s_etat_processus).niveau_courant = 0;
2953: (*s_etat_processus).autorisation_empilement_programme = 'N';
2954: registre_mode_execution_programme =
2955: (*s_etat_processus).mode_execution_programme;
2956: (*s_etat_processus).mode_execution_programme = 'Y';
2957: (*s_etat_processus).erreur_scrutation = d_faux;
2958:
2959: tampon = (*s_etat_processus).instruction_courante;
2960: nombre_lignes_a_supprimer =
2961: (*s_etat_processus).hauteur_pile_operationnelle;
2962:
2963: if ((*s_etat_processus).profilage == d_vrai)
2964: {
2965: profilage(s_etat_processus, "RPL/2 internals");
2966:
2967: if ((*s_etat_processus).erreur_systeme != d_es)
2968: {
2969: return;
2970: }
2971: }
2972:
1.24 bertrand 2973: registre_recherche_type = (*s_etat_processus).recherche_type;
2974: (*s_etat_processus).recherche_type = 'Y';
2975:
1.34 bertrand 2976: variable_implicite =
2977: (*s_etat_processus).autorisation_nom_implicite;
2978: (*s_etat_processus).autorisation_nom_implicite = 'Y';
2979:
1.1 bertrand 2980: if (sequenceur(s_etat_processus) == d_erreur)
2981: {
1.34 bertrand 2982: (*s_etat_processus).autorisation_nom_implicite =
2983: variable_implicite;
1.24 bertrand 2984: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2985: (*s_etat_processus).recherche_type =
2986: registre_recherche_type;
1.1 bertrand 2987: (*s_etat_processus).mode_execution_programme =
2988: registre_mode_execution_programme;
2989: nombre_lignes_a_supprimer =
2990: (*s_etat_processus).hauteur_pile_operationnelle
2991: - nombre_lignes_a_supprimer;
2992:
2993: for(i = 0; i < nombre_lignes_a_supprimer; i++)
2994: {
2995: if (depilement(s_etat_processus,
2996: &((*s_etat_processus).l_base_pile),
2997: &s_sous_objet) == d_erreur)
2998: {
2999: (*s_etat_processus).traitement_interruptible =
3000: registre_interruption;
3001: return;
3002: }
3003:
3004: liberation(s_etat_processus, s_sous_objet);
3005: }
3006:
3007: (*s_etat_processus).instruction_courante = tampon;
3008:
1.12 bertrand 3009: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 3010: (*s_etat_processus).l_base_pile_systeme =
3011: s_sauvegarde_pile;
3012: (*s_etat_processus).niveau_courant =
3013: sauvegarde_niveau_courant;
3014:
3015: free((*s_etat_processus).definitions_chainees);
3016: (*s_etat_processus).niveau_recursivite--;
3017:
3018: (*s_etat_processus).definitions_chainees =
3019: definitions_chainees_precedentes;
3020: (*s_etat_processus).longueur_definitions_chainees =
3021: sauvegarde_longueur_definitions_chainees;
3022:
3023: (*s_etat_processus).position_courante =
3024: position_courante;
3025:
1.47 bertrand 3026: liberation(s_etat_processus, s_objet);
1.1 bertrand 3027:
3028: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3029: (*s_etat_processus).traitement_interruptible =
3030: registre_interruption;
3031: return;
3032: }
3033:
1.34 bertrand 3034: (*s_etat_processus).autorisation_nom_implicite =
3035: variable_implicite;
1.24 bertrand 3036: (*s_etat_processus).recherche_type = registre_recherche_type;
1.1 bertrand 3037: (*s_etat_processus).mode_execution_programme =
3038: registre_mode_execution_programme;
3039:
3040: if ((*s_etat_processus).erreur_scrutation == d_vrai)
3041: {
3042: nombre_lignes_a_supprimer =
3043: (*s_etat_processus).hauteur_pile_operationnelle
3044: - nombre_lignes_a_supprimer;
3045:
3046: for(i = 0; i < nombre_lignes_a_supprimer; i++)
3047: {
3048: if (depilement(s_etat_processus,
3049: &((*s_etat_processus).l_base_pile),
3050: &s_sous_objet) == d_erreur)
3051: {
3052: (*s_etat_processus).traitement_interruptible =
3053: registre_interruption;
3054: return;
3055: }
3056:
3057: liberation(s_etat_processus, s_sous_objet);
3058: }
3059:
3060: (*s_etat_processus).instruction_courante = tampon;
3061:
1.12 bertrand 3062: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 3063: (*s_etat_processus).l_base_pile_systeme =
3064: s_sauvegarde_pile;
3065: (*s_etat_processus).niveau_courant =
3066: sauvegarde_niveau_courant;
3067:
3068: free((*s_etat_processus).definitions_chainees);
3069: (*s_etat_processus).niveau_recursivite--;
3070:
3071: (*s_etat_processus).definitions_chainees =
3072: definitions_chainees_precedentes;
3073: (*s_etat_processus).longueur_definitions_chainees =
3074: sauvegarde_longueur_definitions_chainees;
3075:
3076: (*s_etat_processus).position_courante =
3077: position_courante;
3078:
1.47 bertrand 3079: liberation(s_etat_processus, s_objet);
1.1 bertrand 3080:
3081: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3082: (*s_etat_processus).traitement_interruptible =
3083: registre_interruption;
3084: return;
3085: }
3086:
3087: (*s_etat_processus).instruction_courante = tampon;
3088:
3089: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
3090: (*s_etat_processus).niveau_courant =
3091: sauvegarde_niveau_courant;
3092:
3093: free((*s_etat_processus).definitions_chainees);
3094: (*s_etat_processus).definitions_chainees =
3095: definitions_chainees_precedentes;
3096: (*s_etat_processus).longueur_definitions_chainees =
3097: sauvegarde_longueur_definitions_chainees;
3098:
3099: (*s_etat_processus).niveau_recursivite--;
3100:
3101: (*s_etat_processus).position_courante = position_courante;
3102:
3103: /*
3104: -- On relit la pile qui contient des sous-objets contenant les -----------------
3105: -- éléments du tableau ---------------------------------------------------------
3106: */
3107:
3108: profondeur_finale = (*s_etat_processus)
3109: .hauteur_pile_operationnelle;
3110:
3111: nombre_lignes = profondeur_finale - profondeur_initiale;
3112:
1.12 bertrand 3113: if ((element = malloc(sizeof(struct_tableau))) == NULL)
1.1 bertrand 3114: {
3115: (*s_etat_processus).erreur_systeme =
3116: d_es_allocation_memoire;
3117: (*s_etat_processus).traitement_interruptible =
3118: registre_interruption;
3119: return;
3120: }
3121:
3122: (*((struct_tableau *) element)).nombre_elements = nombre_lignes;
3123:
3124: if (((*((struct_tableau *) element)).elements =
3125: malloc(nombre_lignes * sizeof(struct_objet *))) == NULL)
3126: {
3127: (*s_etat_processus).erreur_systeme =
3128: d_es_allocation_memoire;
3129: (*s_etat_processus).traitement_interruptible =
3130: registre_interruption;
3131: return;
3132: }
3133:
3134: for(i = 1; i <= nombre_lignes; i++)
3135: {
3136: if (depilement(s_etat_processus,
3137: &((*s_etat_processus).l_base_pile),
3138: &s_sous_objet) == d_erreur)
3139: {
3140: (*s_etat_processus).traitement_interruptible =
3141: registre_interruption;
3142: return;
3143: }
3144:
3145: (*((struct_tableau *) element)).elements[nombre_lignes - i]
3146: = s_sous_objet;
3147: }
3148:
3149: (*s_objet).type = TBL;
3150:
3151: (*s_etat_processus).traitement_interruptible =
3152: registre_interruption;
3153: }
3154: else
3155: {
3156: // Définition
3157:
3158: if (strlen((*s_etat_processus).instruction_courante) < 5)
3159: {
1.47 bertrand 3160: liberation(s_etat_processus, s_objet);
1.1 bertrand 3161:
3162: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3163: (*s_etat_processus).traitement_interruptible =
3164: registre_interruption;
3165: return;
3166: }
3167:
3168: if ((strncmp((*s_etat_processus).instruction_courante, "<< ", 3)
3169: != 0) && (strcmp((*s_etat_processus)
3170: .instruction_courante, "<<") != 0))
3171: {
1.47 bertrand 3172: liberation(s_etat_processus, s_objet);
1.1 bertrand 3173:
3174: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3175: (*s_etat_processus).traitement_interruptible =
3176: registre_interruption;
3177: return;
3178: }
3179:
3180: (*s_objet).type = RPN;
3181:
3182: element = (void *) analyse_rpn(s_etat_processus,
3183: (*s_etat_processus).instruction_courante);
3184:
3185: if (element == NULL)
3186: {
3187: if ((*s_etat_processus).erreur_systeme != d_es)
3188: {
3189: (*s_etat_processus).erreur_systeme =
3190: d_es_allocation_memoire;
3191: }
3192:
1.47 bertrand 3193: liberation(s_etat_processus, s_objet);
1.12 bertrand 3194:
1.1 bertrand 3195: (*s_etat_processus).traitement_interruptible =
3196: registre_interruption;
3197: return;
3198: }
3199:
3200: l_element_courant = (struct_liste_chainee *) element;
3201:
3202: while(l_element_courant != NULL)
3203: {
3204: if ((*(*l_element_courant).donnee).type == FCT)
3205: {
3206: if (strcmp((*((struct_fonction *) (*(*l_element_courant)
3207: .donnee).objet)).nom_fonction, "=") == 0)
3208: {
3209: nombre_egalites++;
3210: }
3211: }
3212:
3213: l_element_courant = (*l_element_courant).suivant;
3214: }
3215: }
3216:
3217: break;
3218: }
3219:
3220: /*
3221: --------------------------------------------------------------------------------
3222: Entier ou réel
3223: --------------------------------------------------------------------------------
3224: */
3225:
3226: default :
3227: {
3228: if (((*((*s_etat_processus).instruction_courante)) == '-') ||
3229: ((*((*s_etat_processus).instruction_courante)) == '+') ||
3230: (((*((*s_etat_processus).instruction_courante)) >= '0') &&
3231: ((*((*s_etat_processus).instruction_courante))
3232: <= '9')) || ((*((*s_etat_processus).instruction_courante))
3233: == '.'))
3234: {
3235: drapeau_valeur_entiere = ((*((*s_etat_processus)
3236: .instruction_courante)) != '.') ? d_vrai : d_faux;
3237: drapeau_valeur_reelle = d_vrai;
3238:
3239: nombre_points = 0;
3240: nombre_exposants = 0;
3241:
3242: conversion_format(s_etat_processus,
3243: (*s_etat_processus).instruction_courante);
3244:
3245: ptr = (*s_etat_processus).instruction_courante;
3246:
3247: while((*ptr) != d_code_fin_chaine)
3248: {
3249: switch(*ptr)
3250: {
3251: case '0' :
3252: case '1' :
3253: case '2' :
3254: case '3' :
3255: case '4' :
3256: case '5' :
3257: case '6' :
3258: case '7' :
3259: case '8' :
3260: case '9' :
3261: {
3262: break;
3263: }
3264:
3265: // Ne peut survenir qu'après un 'E', un 'e' ou au
3266: // début de la chaîne.
3267: case '+' :
3268: case '-' :
3269: {
3270: if (ptr > (*s_etat_processus).instruction_courante)
3271: {
3272: if (((*(ptr - 1)) != 'e') &&
3273: ((*(ptr - 1)) != 'E'))
3274: {
3275: drapeau_valeur_entiere = d_faux;
3276: drapeau_valeur_reelle = d_faux;
3277: }
3278: }
3279:
3280: break;
3281: }
3282:
3283: // Ne peut que commencer une chaîne, suivre un
3284: // chiffre ou un signe. Ne peut constituer un
3285: // nombre seul.
3286: case '.' :
3287: {
3288: nombre_points++;
3289:
3290: if (ptr > (*s_etat_processus).instruction_courante)
3291: {
3292: switch(*(ptr - 1))
3293: {
3294: case '+' :
3295: case '-' :
3296: case '0' :
3297: case '1' :
3298: case '2' :
3299: case '3' :
3300: case '4' :
3301: case '5' :
3302: case '6' :
3303: case '7' :
3304: case '8' :
3305: case '9' :
3306: {
3307: drapeau_valeur_entiere = d_faux;
3308: break;
3309: }
3310:
3311: default :
3312: {
3313: drapeau_valeur_entiere = d_faux;
3314: drapeau_valeur_reelle = d_faux;
3315: break;
3316: }
3317: }
3318: }
3319: else
3320: {
3321: if ((*(ptr + 1)) == d_code_fin_chaine)
3322: {
3323: drapeau_valeur_entiere = d_faux;
3324: drapeau_valeur_reelle = d_faux;
3325: }
3326: }
3327:
3328: break;
3329: }
3330:
3331: // Ne peut suivre qu'un chiffre ou un point
3332: case 'e' :
3333: case 'E' :
3334: {
3335: nombre_exposants++;
3336:
3337: if (ptr > (*s_etat_processus).instruction_courante)
3338: {
3339: switch(*(ptr - 1))
3340: {
3341: case '0' :
3342: case '1' :
3343: case '2' :
3344: case '3' :
3345: case '4' :
3346: case '5' :
3347: case '6' :
3348: case '7' :
3349: case '8' :
3350: case '9' :
3351: {
3352: drapeau_valeur_entiere = d_faux;
3353: break;
3354: }
3355:
3356: // Le point doit suivre un chiffre
3357: case '.' :
3358: {
3359: if ((ptr - 1) > (*s_etat_processus)
3360: .instruction_courante)
3361: {
3362: switch(*(ptr - 2))
3363: {
3364: case '0' :
3365: case '1' :
3366: case '2' :
3367: case '3' :
3368: case '4' :
3369: case '5' :
3370: case '6' :
3371: case '7' :
3372: case '8' :
3373: case '9' :
3374: {
3375: drapeau_valeur_entiere =
3376: d_faux;
3377: break;
3378: }
3379:
3380: default :
3381: {
3382: drapeau_valeur_entiere =
3383: d_faux;
3384: drapeau_valeur_reelle =
3385: d_faux;
3386: break;
3387: }
3388: }
3389: }
3390: else
3391: {
3392: drapeau_valeur_entiere = d_faux;
3393: drapeau_valeur_reelle = d_faux;
3394: }
3395:
3396: break;
3397: }
3398:
3399: default :
3400: {
3401: drapeau_valeur_entiere = d_faux;
3402: drapeau_valeur_reelle = d_faux;
3403: break;
3404: }
3405: }
3406: }
3407: else
3408: {
3409: drapeau_valeur_entiere = d_faux;
3410: drapeau_valeur_reelle = d_faux;
3411: }
3412:
3413: break;
3414: }
3415:
3416: default :
3417: {
3418: drapeau_valeur_entiere = d_faux;
3419: drapeau_valeur_reelle = d_faux;
3420: break;
3421: }
3422: }
3423:
3424: ptr++;
3425: }
3426:
3427: if ((nombre_points > 1) || (nombre_exposants > 1))
3428: {
3429: drapeau_valeur_reelle = d_faux;
3430: drapeau_valeur_entiere = d_faux;
3431: }
3432: }
3433: else
3434: {
3435: drapeau_valeur_entiere = d_faux;
3436: drapeau_valeur_reelle = d_faux;
3437: }
3438:
3439: if ((drapeau_valeur_reelle == d_faux) &&
3440: (drapeau_valeur_entiere == d_faux))
3441: {
1.23 bertrand 3442: ptr = (*s_etat_processus).instruction_courante;
3443:
3444: while((*ptr) != d_code_fin_chaine)
3445: {
1.25 bertrand 3446: if ((isalnum((*ptr)) == 0) &&
3447: ((*ptr) != '_') &&
3448: ((*ptr) != '$'))
1.23 bertrand 3449: {
1.47 bertrand 3450: liberation(s_etat_processus, s_objet);
1.23 bertrand 3451:
3452: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3453: (*s_etat_processus).traitement_interruptible =
3454: registre_interruption;
3455:
3456: return;
3457: }
3458:
3459: ptr++;
3460: }
3461:
1.1 bertrand 3462: (*s_objet).type = NOM;
3463:
3464: element = malloc(sizeof(struct_nom));
3465:
3466: if (element == NULL)
3467: {
3468: (*s_etat_processus).erreur_systeme =
3469: d_es_allocation_memoire;
3470: (*s_etat_processus).traitement_interruptible =
3471: registre_interruption;
3472: return;
3473: }
3474:
3475: (*((struct_nom *) element)).symbole = d_faux;
3476: (*((struct_nom *) element)).nom = ((unsigned char *) malloc(
3477: (strlen((*s_etat_processus)
3478: .instruction_courante) + 1) * sizeof(unsigned char)));
3479:
3480: if ((*((struct_nom *) element)).nom == NULL)
3481: {
3482: (*s_etat_processus).erreur_systeme =
3483: d_es_allocation_memoire;
3484: (*s_etat_processus).traitement_interruptible =
3485: registre_interruption;
3486: return;
3487: }
3488:
3489: strcpy((*((struct_nom *) element)).nom, (*s_etat_processus)
3490: .instruction_courante);
3491: }
3492: else
3493: {
3494: if (drapeau_valeur_entiere == d_faux)
3495: {
3496: (*s_objet).type = REL;
3497:
3498: element = (void *) ((real8 *) malloc(
3499: sizeof(real8)));
3500:
3501: if (element == NULL)
3502: {
3503: (*s_etat_processus).erreur_systeme =
3504: d_es_allocation_memoire;
3505: (*s_etat_processus).traitement_interruptible =
3506: registre_interruption;
3507: return;
3508: }
3509:
3510: nombre_elements_convertis = sscanf(
3511: (*s_etat_processus).instruction_courante, "%lg",
3512: (real8 *) element);
3513:
3514: if (nombre_elements_convertis != 1)
3515: {
3516: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3517: }
3518: }
3519: else
3520: {
1.43 bertrand 3521: // Le format ressemble à un entier mais il peut y avoir
3522: // un dépassement de capacité lors de la conversion.
3523: // On convertit donc en entier et en réel. Si les
3524: // deux conversions donnent le même résultat, on
3525: // considère que la conversion en entier est bonne. Dans
3526: // le cas contraire, on garde la conversion en réel.
1.1 bertrand 3527:
1.43 bertrand 3528: integer8 conversion_entiere;
3529: real8 conversion_reelle;
1.1 bertrand 3530:
1.43 bertrand 3531: if (sscanf((*s_etat_processus).instruction_courante, "%lg",
3532: &conversion_reelle) != 1)
1.1 bertrand 3533: {
1.43 bertrand 3534: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1.1 bertrand 3535: }
3536:
1.43 bertrand 3537: if (sscanf((*s_etat_processus).instruction_courante, "%lld",
3538: &conversion_entiere) != 1)
3539: {
3540: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3541: }
1.1 bertrand 3542:
1.43 bertrand 3543: if (abs(nextafter(conversion_reelle, conversion_entiere)
3544: - conversion_reelle) >= abs(conversion_reelle
3545: - conversion_entiere))
1.1 bertrand 3546: {
1.43 bertrand 3547: (*s_objet).type = INT;
3548:
3549: element = malloc(sizeof(integer8));
3550:
3551: if (element == NULL)
3552: {
3553: (*s_etat_processus).erreur_systeme =
3554: d_es_allocation_memoire;
3555: (*s_etat_processus).traitement_interruptible =
3556: registre_interruption;
3557: return;
3558: }
3559:
3560: (*((integer8 *) element)) = conversion_entiere;
3561: }
3562: else
3563: {
3564: (*s_objet).type = REL;
3565:
3566: element = malloc(sizeof(real8));
3567:
3568: if (element == NULL)
3569: {
3570: (*s_etat_processus).erreur_systeme =
3571: d_es_allocation_memoire;
3572: (*s_etat_processus).traitement_interruptible =
3573: registre_interruption;
3574: return;
3575: }
3576:
3577: (*((real8 *) element)) = conversion_reelle;
1.1 bertrand 3578: }
3579: }
3580: }
3581:
3582: break;
3583: }
3584: }
3585:
3586: (*s_objet).objet = element;
3587:
3588: if (nombre_egalites > 1)
3589: {
3590: liberation(s_etat_processus, s_objet);
3591:
3592: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3593: (*s_etat_processus).traitement_interruptible = registre_interruption;
3594: return;
3595: }
3596:
3597: if (empilement(s_etat_processus,
3598: &((*s_etat_processus).l_base_pile), s_objet) == d_erreur)
3599: {
3600: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1.7 bertrand 3601: (*s_etat_processus).traitement_interruptible =
3602: registre_interruption;
1.1 bertrand 3603: return;
3604: }
3605:
3606: (*s_etat_processus).traitement_interruptible = registre_interruption;
3607: return;
3608: }
3609:
3610:
3611: /*
3612: ================================================================================
3613: Conversion de la virgule
3614: ================================================================================
3615: Entrées : structure sur l'état du processus
3616: --------------------------------------------------------------------------------
3617: Sorties : néant
3618: --------------------------------------------------------------------------------
3619: Effets de bord : néant
3620: ================================================================================
3621: */
3622:
3623: void
3624: conversion_format(struct_processus *s_etat_processus, unsigned char *chaine)
3625: {
3626: unsigned char *ptr;
3627:
3628: /*
3629: --------------------------------------------------------------------------------
3630: Transcription du point en virgule et réciproquement selon l'indicateur 48
3631: --------------------------------------------------------------------------------
3632: */
3633:
3634: if (test_cfsf(s_etat_processus, 48) == d_vrai)
3635: {
3636: ptr = chaine;
3637:
3638: while((*ptr) != d_code_fin_chaine)
3639: {
3640: if ((*ptr) == '.')
3641: {
3642: (*ptr) = ',';
3643: }
3644: else if ((*ptr) == ',')
3645: {
3646: (*ptr) = '.';
3647: }
3648:
3649: ptr++;
3650: }
3651: }
3652:
3653: return;
3654: }
3655:
3656: // vim: ts=4