![[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.46 bertrand 3: RPL/2 (R) version 4.1.7
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: {
1464: (*s_etat_processus).erreur_systeme = d_es_pile_vide;
1465: (*s_etat_processus).traitement_interruptible =
1466: registre_interruption;
1467: return;
1468: }
1469: }
1470:
1.47 ! bertrand 1471: s_objet = s_objet_registre;
1.1 bertrand 1472:
1473: if (drapeau_complexe == d_vrai)
1474: {
1475: (*s_objet).type = VCX;
1476: }
1477: else if (drapeau_reel == d_vrai)
1478: {
1479: (*s_objet).type = VRL;
1480: }
1481: else
1482: {
1483: (*s_objet).type = VIN;
1484: }
1485:
1486: break;
1487: }
1488:
1489: /*
1490: --------------------------------------------------------------------------------
1491: Matrice
1492: --------------------------------------------------------------------------------
1493: */
1494:
1495: case d_vrai :
1496: {
1497: nombre_lignes--;
1498:
1499: sauvegarde_longueur_definitions_chainees =
1500: (*s_etat_processus).longueur_definitions_chainees;
1501:
1502: tampon = (unsigned char *) malloc(
1503: (((*s_etat_processus).longueur_definitions_chainees
1504: = strlen((*s_etat_processus).instruction_courante)
1505: + 4) + 1) * sizeof(unsigned char));
1506:
1507: if (tampon == NULL)
1508: {
1509: (*s_etat_processus).erreur_systeme =
1510: d_es_allocation_memoire;
1511: (*s_etat_processus).traitement_interruptible =
1512: registre_interruption;
1513: return;
1514: }
1515:
1516: strcpy(tampon, "<< ");
1517: ptr_ecriture = tampon + 3;
1518: ptr_lecture = (*s_etat_processus).instruction_courante + 1;
1519:
1520: while((*ptr_lecture) != d_code_fin_chaine)
1521: {
1522: *ptr_ecriture++ = *ptr_lecture++;
1523: }
1524:
1525: (*(--ptr_ecriture)) = d_code_fin_chaine;
1526: strcat(ptr_ecriture, " >>");
1527:
1528: position_courante = (*s_etat_processus).position_courante;
1529: (*s_etat_processus).position_courante = 0;
1530:
1531: profondeur_initiale = (*s_etat_processus)
1532: .hauteur_pile_operationnelle;
1533:
1534: /*
1535: -- On met les lignes de la matrice dans la pile opérationnelle -----------------
1536: */
1537:
1538: (*s_etat_processus).niveau_recursivite++;
1539: definitions_chainees_precedentes = (*s_etat_processus)
1540: .definitions_chainees;
1541: (*s_etat_processus).definitions_chainees = tampon;
1542:
1543: s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
1544: sauvegarde_niveau_courant = (*s_etat_processus)
1545: .niveau_courant;
1546:
1547: (*s_etat_processus).l_base_pile_systeme = NULL;
1548: empilement_pile_systeme(s_etat_processus);
1549:
1550: if ((*s_etat_processus).erreur_systeme != d_es)
1551: {
1552: (*s_etat_processus).traitement_interruptible =
1553: registre_interruption;
1554: return;
1555: }
1556:
1557: (*(*s_etat_processus).l_base_pile_systeme)
1558: .retour_definition = 'Y';
1559: (*s_etat_processus).niveau_courant = 0;
1560: (*s_etat_processus).autorisation_empilement_programme = 'N';
1561: registre_mode_execution_programme =
1562: (*s_etat_processus).mode_execution_programme;
1563: (*s_etat_processus).mode_execution_programme = 'Y';
1564: (*s_etat_processus).erreur_scrutation = d_faux;
1565:
1566: tampon = (*s_etat_processus).instruction_courante;
1567: nombre_lignes_a_supprimer =
1568: (*s_etat_processus).hauteur_pile_operationnelle;
1569:
1570: if ((*s_etat_processus).profilage == d_vrai)
1571: {
1572: profilage(s_etat_processus, "RPL/2 internals");
1573:
1574: if ((*s_etat_processus).erreur_systeme != d_es)
1575: {
1576: return;
1577: }
1578: }
1.24 bertrand 1579:
1580: registre_recherche_type = (*s_etat_processus)
1581: .recherche_type;
1582: (*s_etat_processus).recherche_type = 'Y';
1.1 bertrand 1583:
1584: if (sequenceur(s_etat_processus) == d_erreur)
1585: {
1.24 bertrand 1586: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1587: (*s_etat_processus).recherche_type =
1588: registre_recherche_type;
1.1 bertrand 1589: (*s_etat_processus).mode_execution_programme =
1590: registre_mode_execution_programme;
1591: nombre_lignes_a_supprimer =
1592: (*s_etat_processus).hauteur_pile_operationnelle
1593: - nombre_lignes_a_supprimer;
1594:
1595: for(i = 0; i < nombre_lignes_a_supprimer; i++)
1596: {
1597: if (depilement(s_etat_processus,
1598: &((*s_etat_processus).l_base_pile),
1599: &s_sous_objet) == d_erreur)
1600: {
1601: (*s_etat_processus).traitement_interruptible =
1602: registre_interruption;
1603: return;
1604: }
1605:
1606: liberation(s_etat_processus, s_sous_objet);
1607: }
1608:
1609: (*s_etat_processus).instruction_courante = tampon;
1610:
1.12 bertrand 1611: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 1612: (*s_etat_processus).l_base_pile_systeme =
1613: s_sauvegarde_pile;
1614: (*s_etat_processus).niveau_courant =
1615: sauvegarde_niveau_courant;
1616:
1617: free((*s_etat_processus).definitions_chainees);
1618: (*s_etat_processus).niveau_recursivite--;
1619:
1620: (*s_etat_processus).definitions_chainees =
1621: definitions_chainees_precedentes;
1622: (*s_etat_processus).longueur_definitions_chainees =
1623: sauvegarde_longueur_definitions_chainees;
1624:
1625: (*s_etat_processus).position_courante =
1626: position_courante;
1627:
1.47 ! bertrand 1628: liberation(s_etat_processus, s_objet);
1.1 bertrand 1629:
1630: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1631: (*s_etat_processus).traitement_interruptible =
1632: registre_interruption;
1633: return;
1634: }
1635:
1.24 bertrand 1636: (*s_etat_processus).recherche_type =
1637: registre_recherche_type;
1.1 bertrand 1638: (*s_etat_processus).mode_execution_programme =
1639: registre_mode_execution_programme;
1640:
1641: if ((*s_etat_processus).erreur_scrutation == d_vrai)
1642: {
1643: nombre_lignes_a_supprimer =
1644: (*s_etat_processus).hauteur_pile_operationnelle
1645: - nombre_lignes_a_supprimer;
1646:
1647: for(i = 0; i < nombre_lignes_a_supprimer; i++)
1648: {
1649: if (depilement(s_etat_processus,
1650: &((*s_etat_processus).l_base_pile),
1651: &s_sous_objet) == d_erreur)
1652: {
1653: (*s_etat_processus).traitement_interruptible =
1654: registre_interruption;
1655: return;
1656: }
1657:
1658: liberation(s_etat_processus, s_sous_objet);
1659: }
1660:
1661: (*s_etat_processus).instruction_courante = tampon;
1662:
1.12 bertrand 1663: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 1664: (*s_etat_processus).l_base_pile_systeme =
1665: s_sauvegarde_pile;
1666: (*s_etat_processus).niveau_courant =
1667: sauvegarde_niveau_courant;
1668:
1669: free((*s_etat_processus).definitions_chainees);
1670: (*s_etat_processus).niveau_recursivite--;
1671:
1672: (*s_etat_processus).definitions_chainees =
1673: definitions_chainees_precedentes;
1674: (*s_etat_processus).longueur_definitions_chainees =
1675: sauvegarde_longueur_definitions_chainees;
1676:
1677: (*s_etat_processus).position_courante =
1678: position_courante;
1679:
1.47 ! bertrand 1680: liberation(s_etat_processus, s_objet);
1.1 bertrand 1681:
1682: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1683: (*s_etat_processus).traitement_interruptible =
1684: registre_interruption;
1685: return;
1686: }
1687:
1688: (*s_etat_processus).instruction_courante = tampon;
1689:
1690: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
1691: (*s_etat_processus).niveau_courant =
1692: sauvegarde_niveau_courant;
1693:
1694: free((*s_etat_processus).definitions_chainees);
1695: (*s_etat_processus).definitions_chainees =
1696: definitions_chainees_precedentes;
1697: (*s_etat_processus).longueur_definitions_chainees =
1698: sauvegarde_longueur_definitions_chainees;
1699:
1700: (*s_etat_processus).niveau_recursivite--;
1701:
1702: (*s_etat_processus).position_courante = position_courante;
1703:
1704: /*
1705: -- On relit la pile qui contient des objets "vecteurs" contenant les -----------
1706: -- lignes de la matrice --------------------------------------------------------
1707: */
1708:
1709: profondeur_finale = (*s_etat_processus)
1710: .hauteur_pile_operationnelle;
1711:
1712: nombre_lignes = profondeur_finale - profondeur_initiale;
1713:
1714: element = (void *) ((struct_matrice *) malloc(
1715: sizeof(struct_matrice)));
1716:
1717: if (element == NULL)
1718: {
1719: (*s_etat_processus).erreur_systeme =
1720: d_es_allocation_memoire;
1721: (*s_etat_processus).traitement_interruptible =
1722: registre_interruption;
1723: return;
1724: }
1725:
1726: (*((struct_matrice *) element))
1727: .nombre_lignes = nombre_lignes;
1728: (*((struct_matrice *) element)).nombre_colonnes =
1729: (*((struct_vecteur *) ((*(*(*s_etat_processus)
1730: .l_base_pile).donnee).objet))).taille;
1731: nombre_colonnes = (*((struct_matrice *)
1732: element)).nombre_colonnes;
1733:
1734: l_element_courant = (*s_etat_processus).l_base_pile;
1735:
1736: drapeau_complexe = d_faux;
1737: drapeau_reel = d_faux;
1738: erreur = d_absence_erreur;
1739:
1740: for(i = 0; i < nombre_lignes; i++)
1741: {
1742: if (nombre_colonnes != (*((struct_vecteur *)
1743: (*(*l_element_courant).donnee).objet)).taille)
1744: {
1745: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1746:
1747: for(j = 0; j < nombre_lignes; j++)
1748: {
1749: if (depilement(s_etat_processus,
1750: &((*s_etat_processus).l_base_pile),
1751: &s_sous_objet) == d_erreur)
1752: {
1753: (*s_etat_processus)
1754: .traitement_interruptible =
1755: registre_interruption;
1756: return;
1757: }
1758:
1759: liberation(s_etat_processus, s_sous_objet);
1760: }
1761:
1762: free(element);
1.47 ! bertrand 1763: liberation(s_etat_processus, s_objet);
1.1 bertrand 1764:
1765: (*s_etat_processus).traitement_interruptible =
1766: registre_interruption;
1767: return;
1768: }
1769:
1770: if ((*(*l_element_courant)
1771: .donnee).type == VRL)
1772: {
1773: drapeau_reel = d_vrai;
1774: }
1775: else if ((*(*l_element_courant)
1776: .donnee).type == VCX)
1777: {
1778: drapeau_complexe = d_vrai;
1779: }
1780:
1781: l_element_courant = (*l_element_courant).suivant;
1782: }
1783:
1.47 ! bertrand 1784: s_objet_registre = s_objet;
1.1 bertrand 1785:
1786: if ((*s_etat_processus).erreur_execution == d_ex)
1787: {
1788: if (drapeau_complexe == d_vrai)
1789: {
1790: if (((*((struct_matrice *) element)).tableau =
1791: (void **) ((struct_complexe16 **)
1792: malloc(nombre_lignes * sizeof(
1793: struct_complexe16 *)))) == NULL)
1794: {
1.47 ! bertrand 1795: liberation(s_etat_processus, s_objet_registre);
! 1796:
1.1 bertrand 1797: (*s_etat_processus).erreur_systeme =
1798: d_es_allocation_memoire;
1799: (*s_etat_processus).traitement_interruptible =
1800: registre_interruption;
1801: return;
1802: }
1803:
1804: (*((struct_matrice *) element)).type = 'C';
1805:
1806: for(i = 0; i < nombre_lignes; i++)
1807: {
1808: if ((((*((struct_matrice *)
1809: element)).tableau)[i] = (void *)
1810: ((struct_complexe16 *)
1811: malloc(nombre_colonnes * sizeof(
1812: struct_complexe16)))) == NULL)
1813: {
1.47 ! bertrand 1814: liberation(s_etat_processus,
! 1815: s_objet_registre);
! 1816:
1.1 bertrand 1817: (*s_etat_processus).erreur_systeme =
1818: d_es_allocation_memoire;
1819: (*s_etat_processus)
1820: .traitement_interruptible =
1821: registre_interruption;
1822: return;
1823: }
1824: }
1825: }
1826: else if (drapeau_reel == d_vrai)
1827: {
1828: if (((*((struct_matrice *) element)).tableau =
1829: (void **) ((real8 **)
1830: malloc(nombre_lignes * sizeof(real8 *))))
1831: == NULL)
1832: {
1.47 ! bertrand 1833: liberation(s_etat_processus, s_objet_registre);
! 1834:
1.1 bertrand 1835: (*s_etat_processus).erreur_systeme =
1836: d_es_allocation_memoire;
1837: (*s_etat_processus).traitement_interruptible =
1838: registre_interruption;
1839: return;
1840: }
1841:
1842: (*((struct_matrice *) element)).type = 'R';
1843:
1844: for(i = 0; i < nombre_lignes; i++)
1845: {
1846: if ((((*((struct_matrice *)element)).tableau)[i]
1847: = (void *) ((real8 *)
1848: malloc(nombre_colonnes *
1849: sizeof(real8)))) == NULL)
1850: {
1.47 ! bertrand 1851: liberation(s_etat_processus,
! 1852: s_objet_registre);
! 1853:
1.1 bertrand 1854: (*s_etat_processus).erreur_systeme =
1855: d_es_allocation_memoire;
1856: (*s_etat_processus)
1857: .traitement_interruptible =
1858: registre_interruption;
1859: return;
1860: }
1861: }
1862: }
1863: else
1864: {
1865: if (((*((struct_matrice *) element)).tableau =
1866: (void **) ((integer8 **)
1867: malloc(nombre_lignes *
1868: sizeof(integer8 *)))) == NULL)
1869: {
1.47 ! bertrand 1870: liberation(s_etat_processus, s_objet_registre);
! 1871:
1.1 bertrand 1872: (*s_etat_processus).erreur_systeme =
1873: d_es_allocation_memoire;
1874: (*s_etat_processus).traitement_interruptible =
1875: registre_interruption;
1876: return;
1877: }
1878:
1879: (*((struct_matrice *) element)).type = 'I';
1880:
1881: for(i = 0; i < nombre_lignes; i++)
1882: {
1883: if ((((*((struct_matrice *)
1884: element)).tableau)[i] = (void *)
1885: ((integer8 *)
1886: malloc(nombre_colonnes *
1887: sizeof(integer8)))) == NULL)
1888: {
1.47 ! bertrand 1889: liberation(s_etat_processus,
! 1890: s_objet_registre);
! 1891:
1.1 bertrand 1892: (*s_etat_processus).erreur_systeme =
1893: d_es_allocation_memoire;
1894: (*s_etat_processus)
1895: .traitement_interruptible =
1896: registre_interruption;
1897: return;
1898: }
1899: }
1900: }
1901:
1902: for(i = 0; i < nombre_lignes; i++)
1903: {
1904: if (depilement(s_etat_processus,
1905: &((*s_etat_processus)
1906: .l_base_pile), &s_objet) ==
1907: d_absence_erreur)
1908: {
1909: if (drapeau_complexe == d_vrai)
1910: {
1911: if ((*s_objet).type == VCX)
1912: {
1913: for(j = 0; j < nombre_colonnes; j++)
1914: {
1915: ((struct_complexe16 **) ((*(
1916: (struct_matrice *) element))
1917: .tableau))[nombre_lignes - i
1918: - 1][j] =
1919: ((struct_complexe16 *)
1920: (*((struct_vecteur *)
1921: (*s_objet).objet))
1922: .tableau)[j];
1923: }
1924: }
1925: else if ((*s_objet).type == VRL)
1926: {
1927: for(j = 0; j < nombre_colonnes; j++)
1928: {
1929: (((struct_complexe16 **) ((*(
1930: (struct_matrice *) element))
1931: .tableau))[nombre_lignes - i
1932: - 1][j]).partie_reelle =
1933: ((real8 *) (*(
1934: (struct_vecteur *)
1935: (*s_objet).objet))
1936: .tableau)[j];
1937: (((struct_complexe16 **) ((*(
1938: (struct_matrice *) element))
1939: .tableau))[nombre_lignes - i
1940: - 1][j]).partie_imaginaire =
1941: (real8) 0;
1942: }
1943: }
1944: else if ((*s_objet).type == VIN)
1945: {
1946: for(j = 0; j < nombre_colonnes; j++)
1947: {
1948: (((struct_complexe16 **) ((*(
1949: (struct_matrice *) element))
1950: .tableau))[nombre_lignes - i
1951: - 1][j]).partie_reelle =
1952: (real8) ((integer8 *)
1953: (*((struct_vecteur *)
1954: (*s_objet).objet)).tableau)
1955: [j];
1956: (((struct_complexe16 **) ((*(
1957: (struct_matrice *) element))
1958: .tableau))[nombre_lignes - i
1959: - 1][j]).partie_imaginaire =
1960: (real8) 0;
1961: }
1962: }
1963: else
1964: {
1965: erreur = d_erreur;
1966: }
1967: }
1968: else if (drapeau_reel == d_vrai)
1969: {
1970: if ((*s_objet).type == VRL)
1971: {
1972: for(j = 0; j < nombre_colonnes; j++)
1973: {
1974: ((real8 **) ((*((struct_matrice *)
1975: element)).tableau))
1976: [nombre_lignes - i - 1][j] =
1977: ((real8 *) (*(
1978: (struct_vecteur *)
1979: (*s_objet).objet)).tableau)
1980: [j];
1981: }
1982: }
1983: else if ((*s_objet).type == VIN)
1984: {
1985: for(j = 0; j < nombre_colonnes; j++)
1986: {
1987: ((real8 **) ((*((struct_matrice *)
1988: element)).tableau))
1989: [nombre_lignes - i - 1][j] =
1990: (real8) ((integer8 *)
1991: (*((struct_vecteur *)
1992: (*s_objet).objet)).tableau)
1993: [j];
1994: }
1995: }
1996: else
1997: {
1998: erreur = d_erreur;
1999: }
2000: }
2001: else
2002: {
2003: if ((*s_objet).type == VIN)
2004: {
2005: for(j = 0; j < nombre_colonnes; j++)
2006: {
2007: ((integer8 **)
2008: ((*((struct_matrice *)
2009: element)).tableau))
2010: [nombre_lignes - i - 1][j] =
2011: ((integer8 *)
2012: (*((struct_vecteur *)
2013: (*s_objet)
2014: .objet)).tableau)[j];
2015: }
2016: }
2017: else
2018: {
2019: erreur = d_erreur;
2020: }
2021: }
2022:
2023: liberation(s_etat_processus, s_objet);
2024:
2025: if (erreur == d_erreur)
2026: {
2027: for(i++; i < nombre_lignes; i++)
2028: {
2029: if (depilement(s_etat_processus,
2030: &((*s_etat_processus)
2031: .l_base_pile), &s_objet)
2032: == d_erreur)
2033: {
1.47 ! bertrand 2034: liberation(s_etat_processus,
! 2035: s_objet_registre);
! 2036:
1.1 bertrand 2037: (*s_etat_processus)
2038: .traitement_interruptible =
2039: registre_interruption;
2040: return;
2041: }
2042:
2043: liberation(s_etat_processus, s_objet);
2044: }
2045:
2046: (*s_etat_processus).erreur_execution =
2047: d_ex_syntaxe;
2048:
2049: for(j = 0; j < (*((struct_matrice *)
2050: element)).nombre_lignes; j++)
2051: {
2052: free((*((struct_matrice *) element))
2053: .tableau[j]);
2054: }
2055:
2056: free((*((struct_matrice *) element))
2057: .tableau);
2058: free(element);
2059:
1.47 ! bertrand 2060: liberation(s_etat_processus,
! 2061: s_objet_registre);
! 2062:
1.1 bertrand 2063: (*s_etat_processus)
2064: .traitement_interruptible =
2065: registre_interruption;
2066: return;
2067: }
2068: }
2069: else
2070: {
2071: (*s_etat_processus).erreur_systeme =
2072: d_es_pile_vide;
2073: (*s_etat_processus).traitement_interruptible =
2074: registre_interruption;
2075: return;
2076: }
2077: }
2078:
1.47 ! bertrand 2079: s_objet = s_objet_registre;
1.1 bertrand 2080:
2081: if (drapeau_complexe == d_vrai)
2082: {
2083: (*s_objet).type = MCX;
2084: }
2085: else if (drapeau_reel == d_vrai)
2086: {
2087: (*s_objet).type = MRL;
2088: }
2089: else
2090: {
2091: (*s_objet).type = MIN;
2092: }
2093: }
2094: else
2095: {
2096: if ((*s_etat_processus).langue == 'F')
2097: {
2098: printf("+++Erreur : Matrice %s invalide [%d]\n",
2099: (*s_etat_processus).instruction_courante,
2100: (int) getpid());
2101: }
2102: else
2103: {
2104: printf("+++Error : Invalid %s matrix [%d]\n",
2105: (*s_etat_processus).instruction_courante,
2106: (int) getpid());
2107: }
2108:
2109: fflush(stdout);
2110: }
2111:
2112: break;
2113: }
2114: }
2115:
2116: break;
2117: }
2118:
2119: /*
2120: --------------------------------------------------------------------------------
2121: Liste
2122: --------------------------------------------------------------------------------
2123: */
2124:
2125: case '{' :
2126: {
2127: sauvegarde_longueur_definitions_chainees =
2128: (*s_etat_processus).longueur_definitions_chainees;
2129:
2130: tampon = (unsigned char *) malloc(
2131: (((*s_etat_processus).longueur_definitions_chainees =
2132: strlen((*s_etat_processus).instruction_courante) + 4) + 1)
2133: * sizeof(unsigned char));
2134:
2135: if (tampon == NULL)
2136: {
2137: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2138: (*s_etat_processus).traitement_interruptible =
2139: registre_interruption;
2140: return;
2141: }
2142:
2143: strcpy(tampon, "<< ");
2144: ptr_ecriture = tampon + 3;
2145: ptr_lecture = (*s_etat_processus).instruction_courante + 1;
2146:
2147: while((*ptr_lecture) != d_code_fin_chaine)
2148: {
2149: *ptr_ecriture++ = *ptr_lecture++;
2150: }
2151:
2152: (*(--ptr_ecriture)) = d_code_fin_chaine;
2153: strcat(ptr_ecriture, " >>");
2154:
2155: position_courante = (*s_etat_processus).position_courante;
2156: (*s_etat_processus).position_courante = 0;
2157:
2158: profondeur_initiale = (*s_etat_processus)
2159: .hauteur_pile_operationnelle;
2160:
2161: /*
2162: -- On met le tout dans la pile opérationnelle. ---------------------------------
2163: */
2164:
2165: (*s_etat_processus).niveau_recursivite++;
2166: definitions_chainees_precedentes = (*s_etat_processus)
2167: .definitions_chainees;
2168: (*s_etat_processus).definitions_chainees = tampon;
2169:
2170: s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
2171: sauvegarde_niveau_courant = (*s_etat_processus).niveau_courant;
2172:
2173: (*s_etat_processus).l_base_pile_systeme = NULL;
2174: empilement_pile_systeme(s_etat_processus);
2175:
2176: if ((*s_etat_processus).erreur_systeme != d_es)
2177: {
2178: (*s_etat_processus).traitement_interruptible =
2179: registre_interruption;
2180: return;
2181: }
2182:
2183: (*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'Y';
2184: (*(*s_etat_processus).l_base_pile_systeme)
2185: .origine_routine_evaluation = 'N';
2186: (*s_etat_processus).niveau_courant = 0;
2187: (*s_etat_processus).autorisation_empilement_programme = 'N';
2188:
2189: tampon = (*s_etat_processus).instruction_courante;
2190: autorisation_evaluation_nom = (*s_etat_processus)
2191: .autorisation_evaluation_nom;
2192: (*s_etat_processus).autorisation_evaluation_nom = 'N';
2193:
2194: registre_test = (*s_etat_processus).test_instruction;
2195: (*s_etat_processus).test_instruction = 'Y';
2196: registre_mode_execution_programme =
2197: (*s_etat_processus).mode_execution_programme;
2198: (*s_etat_processus).mode_execution_programme = 'Y';
2199: (*s_etat_processus).erreur_scrutation = d_faux;
2200:
2201: nombre_lignes_a_supprimer =
2202: (*s_etat_processus).hauteur_pile_operationnelle;
2203:
2204: /*
2205: * Vérification de la cohérence des arguments.
2206: * Il doit y avoir autant de '<<' que de '>>' dans
2207: * l'expression candidate.
2208: */
2209:
2210: coherence_liste = 0;
2211: drapeau_chaine = d_faux;
2212:
2213: while((*s_etat_processus).definitions_chainees
2214: [(*s_etat_processus).position_courante] !=
2215: d_code_fin_chaine)
2216: {
2217: if ((*s_etat_processus).definitions_chainees
2218: [(*s_etat_processus).position_courante] == '"')
2219: {
2220: if (drapeau_chaine == d_faux)
2221: {
2222: drapeau_chaine = d_vrai;
2223: }
2224: else
2225: {
2226: drapeau_chaine = d_faux;
2227: }
2228: }
2229: else if (drapeau_chaine == d_faux)
2230: {
2231: if (((*s_etat_processus).definitions_chainees
2232: [(*s_etat_processus).position_courante] == '<') &&
2233: ((*s_etat_processus).definitions_chainees
2234: [(*s_etat_processus).position_courante + 1] == '<'))
2235: {
2236: coherence_liste++;
2237: }
2238: else if (((*s_etat_processus).definitions_chainees
2239: [(*s_etat_processus).position_courante] == '>') &&
2240: ((*s_etat_processus).definitions_chainees
2241: [(*s_etat_processus).position_courante + 1] == '>'))
2242: {
2243: coherence_liste--;
2244: }
2245:
2246: }
2247:
2248: (*s_etat_processus).position_courante++;
2249: }
2250:
2251: (*s_etat_processus).position_courante = 0;
2252:
2253: if ((coherence_liste != 0) || (drapeau_chaine == d_vrai))
2254: {
2255: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2256:
2257: nombre_lignes_a_supprimer =
2258: (*s_etat_processus).hauteur_pile_operationnelle
2259: - nombre_lignes_a_supprimer;
2260:
2261: for(i = 0; i < nombre_lignes_a_supprimer; i++)
2262: {
2263: if (depilement(s_etat_processus, &((*s_etat_processus)
2264: .l_base_pile), &s_sous_objet) == d_erreur)
2265: {
2266: (*s_etat_processus).traitement_interruptible =
2267: registre_interruption;
2268: (*s_etat_processus).mode_execution_programme =
2269: registre_mode_execution_programme;
2270: return;
2271: }
2272:
2273: liberation(s_etat_processus, s_sous_objet);
2274: }
2275:
2276: (*s_etat_processus).test_instruction = registre_test;
2277: (*s_etat_processus).longueur_definitions_chainees =
2278: sauvegarde_longueur_definitions_chainees;
2279:
2280: (*s_etat_processus).instruction_courante = tampon;
2281: (*s_etat_processus).autorisation_evaluation_nom =
2282: autorisation_evaluation_nom;
2283:
1.12 bertrand 2284: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 2285: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2286: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2287:
2288: free((*s_etat_processus).definitions_chainees);
1.47 ! bertrand 2289: liberation(s_etat_processus, s_objet);
1.1 bertrand 2290:
2291: (*s_etat_processus).definitions_chainees =
2292: definitions_chainees_precedentes;
2293:
2294: (*s_etat_processus).niveau_recursivite--;
2295:
2296: (*s_etat_processus).position_courante = position_courante;
2297:
2298: (*s_etat_processus).traitement_interruptible =
2299: registre_interruption;
2300: (*s_etat_processus).mode_execution_programme =
2301: registre_mode_execution_programme;
2302: return;
2303: }
2304:
2305: /*
2306: * Scrutation de la séquence.
2307: */
2308:
2309: (*s_etat_processus).position_courante = 0;
2310:
2311: if ((*s_etat_processus).profilage == d_vrai)
2312: {
2313: profilage(s_etat_processus, "RPL/2 internals");
2314:
2315: if ((*s_etat_processus).erreur_systeme != d_es)
2316: {
2317: return;
2318: }
2319: }
2320:
1.34 bertrand 2321: variable_implicite = (*s_etat_processus).autorisation_nom_implicite;
1.24 bertrand 2322: registre_recherche_type = (*s_etat_processus).recherche_type;
2323: (*s_etat_processus).recherche_type = 'Y';
1.34 bertrand 2324: (*s_etat_processus).autorisation_nom_implicite = 'Y';
1.24 bertrand 2325:
1.1 bertrand 2326: if (sequenceur(s_etat_processus) == d_erreur)
2327: {
1.34 bertrand 2328: (*s_etat_processus).autorisation_nom_implicite =
2329: variable_implicite;
1.24 bertrand 2330: (*s_etat_processus).recherche_type = registre_recherche_type;
1.1 bertrand 2331: (*s_etat_processus).mode_execution_programme =
2332: registre_mode_execution_programme;
1.34 bertrand 2333:
2334: if ((*s_etat_processus).erreur_execution !=
2335: d_ex_nom_implicite)
2336: {
2337: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2338: }
1.1 bertrand 2339:
2340: nombre_lignes_a_supprimer =
2341: (*s_etat_processus).hauteur_pile_operationnelle
2342: - nombre_lignes_a_supprimer;
2343:
2344: for(i = 0; i < nombre_lignes_a_supprimer; i++)
2345: {
2346: if (depilement(s_etat_processus, &((*s_etat_processus)
2347: .l_base_pile), &s_sous_objet) == d_erreur)
2348: {
2349: (*s_etat_processus).traitement_interruptible =
2350: registre_interruption;
2351: return;
2352: }
2353:
2354: liberation(s_etat_processus, s_sous_objet);
2355: }
2356:
2357: (*s_etat_processus).test_instruction = registre_test;
2358: (*s_etat_processus).longueur_definitions_chainees =
2359: sauvegarde_longueur_definitions_chainees;
2360:
2361: (*s_etat_processus).instruction_courante = tampon;
2362: (*s_etat_processus).autorisation_evaluation_nom =
2363: autorisation_evaluation_nom;
2364:
1.12 bertrand 2365: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 2366: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2367: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2368:
2369: free((*s_etat_processus).definitions_chainees);
1.47 ! bertrand 2370: liberation(s_etat_processus, s_objet);
1.1 bertrand 2371:
2372: (*s_etat_processus).definitions_chainees =
2373: definitions_chainees_precedentes;
2374:
2375: (*s_etat_processus).niveau_recursivite--;
2376:
2377: (*s_etat_processus).position_courante = position_courante;
2378:
2379: (*s_etat_processus).traitement_interruptible =
2380: registre_interruption;
2381: return;
2382: }
2383:
1.34 bertrand 2384: (*s_etat_processus).autorisation_nom_implicite = variable_implicite;
1.24 bertrand 2385: (*s_etat_processus).recherche_type = registre_recherche_type;
1.1 bertrand 2386: (*s_etat_processus).mode_execution_programme =
2387: registre_mode_execution_programme;
2388:
2389: if ((*s_etat_processus).erreur_scrutation == d_vrai)
2390: {
2391: nombre_lignes_a_supprimer =
2392: (*s_etat_processus).hauteur_pile_operationnelle
2393: - nombre_lignes_a_supprimer;
2394:
2395: for(i = 0; i < nombre_lignes_a_supprimer; i++)
2396: {
2397: if (depilement(s_etat_processus, &((*s_etat_processus)
2398: .l_base_pile), &s_sous_objet) == d_erreur)
2399: {
2400: (*s_etat_processus).traitement_interruptible =
2401: registre_interruption;
2402: return;
2403: }
2404:
2405: liberation(s_etat_processus, s_sous_objet);
2406: }
2407:
2408: (*s_etat_processus).test_instruction = registre_test;
2409: (*s_etat_processus).longueur_definitions_chainees =
2410: sauvegarde_longueur_definitions_chainees;
2411:
2412: (*s_etat_processus).instruction_courante = tampon;
2413: (*s_etat_processus).autorisation_evaluation_nom =
2414: autorisation_evaluation_nom;
2415:
1.12 bertrand 2416: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 2417: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2418: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2419:
2420: free((*s_etat_processus).definitions_chainees);
1.47 ! bertrand 2421: liberation(s_etat_processus, s_objet);
1.1 bertrand 2422:
2423: (*s_etat_processus).definitions_chainees =
2424: definitions_chainees_precedentes;
2425:
2426: (*s_etat_processus).niveau_recursivite--;
2427: (*s_etat_processus).position_courante = position_courante;
2428:
2429: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2430: (*s_etat_processus).traitement_interruptible =
2431: registre_interruption;
2432: return;
2433: }
2434:
2435: (*s_etat_processus).test_instruction = registre_test;
2436: (*s_etat_processus).longueur_definitions_chainees =
2437: sauvegarde_longueur_definitions_chainees;
2438:
2439: (*s_etat_processus).instruction_courante = tampon;
2440: (*s_etat_processus).autorisation_evaluation_nom =
2441: autorisation_evaluation_nom;
2442:
2443: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2444: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2445:
2446: free((*s_etat_processus).definitions_chainees);
2447: (*s_etat_processus).definitions_chainees =
2448: definitions_chainees_precedentes;
2449:
2450: (*s_etat_processus).niveau_recursivite--;
2451:
2452: (*s_etat_processus).position_courante = position_courante;
2453:
2454: /*
2455: -- Relecture de la pile opérationnelle -----------------------------------------
2456: */
2457:
2458: profondeur_finale = (*s_etat_processus).hauteur_pile_operationnelle;
2459:
2460: l_element_courant = NULL;
1.47 ! bertrand 2461: s_objet_registre = s_objet;
1.1 bertrand 2462:
2463: for(i = 0; i < (profondeur_finale - profondeur_initiale); i++)
2464: {
2465: if (depilement(s_etat_processus,
2466: &((*s_etat_processus).l_base_pile),
2467: &s_objet) == d_erreur)
2468: {
1.47 ! bertrand 2469: liberation(s_etat_processus, s_objet_registre);
1.1 bertrand 2470: (*s_etat_processus).traitement_interruptible =
2471: registre_interruption;
2472: return;
2473: }
2474:
2475: if (empilement(s_etat_processus, &l_element_courant,
2476: s_objet) == d_erreur)
2477: {
1.47 ! bertrand 2478: liberation(s_etat_processus, s_objet_registre);
1.1 bertrand 2479: (*s_etat_processus).traitement_interruptible =
2480: registre_interruption;
2481: return;
2482: }
2483: }
2484:
1.47 ! bertrand 2485: s_objet = s_objet_registre;
1.1 bertrand 2486: (*s_objet).type = LST;
2487: element = (void *) l_element_courant;
2488:
2489: break;
2490: }
2491:
2492: /*
2493: --------------------------------------------------------------------------------
2494: Nom ou expression algébrique
2495: --------------------------------------------------------------------------------
2496: */
2497:
2498: case '\'' :
2499: {
2500: if ((tampon = analyse_algebrique(s_etat_processus,
2501: (*s_etat_processus).instruction_courante,
2502: &l_base_liste_fonctions)) == NULL)
2503: {
2504: /*
2505: * L'erreur est de type exécution ou système.
2506: * Dans le doute, on libère *s_objet.
2507: */
2508:
2509: while(l_base_liste_fonctions != NULL)
2510: {
2511: l_element_courant_fonctions = l_base_liste_fonctions;
2512: l_base_liste_fonctions = (*l_base_liste_fonctions).suivant;
2513:
2514: free((*((struct_fonction *) (*l_element_courant_fonctions)
2515: .donnee)).nom_fonction);
2516: free((struct_fonction *) (*l_element_courant_fonctions)
2517: .donnee);
2518: free(l_element_courant_fonctions);
2519: }
2520:
1.47 ! bertrand 2521: liberation(s_etat_processus, s_objet);
1.1 bertrand 2522:
2523: (*s_etat_processus).traitement_interruptible =
2524: registre_interruption;
2525: return;
2526: }
2527:
2528: l_base_liste_decomposition = analyse_rpn(s_etat_processus, tampon);
2529: l_element_courant = l_base_liste_decomposition;
2530: nombre_elements = 0;
2531:
2532: while(l_element_courant != NULL)
2533: {
2534: nombre_elements++;
2535: l_element_courant = (*l_element_courant).suivant;
2536: }
2537:
2538: if (nombre_elements == 3)
2539: {
2540: free(tampon);
2541:
2542: (*s_objet).type = (*(*(*l_base_liste_decomposition)
2543: .suivant).donnee).type;
2544: element = (void *) (*(*(*l_base_liste_decomposition)
2545: .suivant).donnee).objet;
2546:
2547: if ((*s_objet).type == NOM)
2548: {
2549: (*((struct_nom *) (*(*(*l_base_liste_decomposition)
2550: .suivant).donnee).objet)).symbole = d_vrai;
2551: }
2552: else if ((*s_objet).type == FCT)
2553: {
2554: /*
2555: * On essaye de mettre d'utiliser une fonction
2556: * comme un nom... On convertit la fonction en nom
2557: * puis on renvoie une erreur.
2558: */
2559:
1.47 ! bertrand 2560: (*s_objet).type = NON;
! 2561: liberation(s_etat_processus, s_objet);
1.1 bertrand 2562:
2563: l_element_courant = l_base_liste_decomposition;
2564:
2565: while(l_element_courant != NULL)
2566: {
2567: liberation(s_etat_processus,
2568: (*l_element_courant).donnee);
2569: l_element_precedent = l_element_courant;
2570: l_element_courant = (*l_element_courant).suivant;
2571: free(l_element_precedent);
2572: }
2573:
2574: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2575: (*s_etat_processus).traitement_interruptible =
2576: registre_interruption;
2577: return;
2578: }
2579:
2580: l_element_precedent = l_base_liste_decomposition;
2581: l_element_courant = (*l_element_precedent).suivant;
2582: liberation(s_etat_processus, (*l_element_precedent).donnee);
2583: free(l_element_precedent);
2584: l_element_precedent = l_element_courant;
2585: l_element_courant = (*l_element_courant).suivant;
2586: free((*l_element_precedent).donnee);
2587: free(l_element_precedent);
2588: liberation(s_etat_processus, (*l_element_courant).donnee);
2589: free(l_element_courant);
2590: }
2591: else
2592: {
2593: (*s_objet).type = ALG;
2594:
2595: if ((*s_etat_processus).debug == d_vrai)
2596: if (((*s_etat_processus).type_debug &
2597: d_debug_variables) != 0)
2598: {
2599: if ((*s_etat_processus).langue == 'F')
2600: {
2601: printf("[%d] Conversion de l'expression en "
2602: "notation polonaise inversée\n%s\n",
2603: (int) getpid(), tampon);
2604: }
2605: else
2606: {
2607: printf("[%d] Translation of expression "
2608: "into reverse polish notation\n%s",
2609: (int) getpid(), tampon);
2610: }
2611:
2612: fflush(stdout);
2613: }
2614:
2615: element = (void *) l_base_liste_decomposition;
2616: free(tampon);
2617:
2618: if (element == NULL)
2619: {
2620: (*s_etat_processus).erreur_execution =
2621: d_ex_expression_invalide;
2622: (*s_etat_processus).traitement_interruptible =
2623: registre_interruption;
2624: return;
2625: }
2626:
2627: l_element_courant = (struct_liste_chainee *) element;
2628:
2629: while(l_element_courant != NULL)
2630: {
2631: if ((*(*l_element_courant).donnee).type == FCT)
2632: {
2633: /*
2634: * Si la fonction est intrinsèque au langage,
2635: * elle est convertie en majuscules.
2636: */
2637:
2638: tampon = conversion_majuscule((*((struct_fonction *)
2639: (*(*l_element_courant).donnee).objet))
2640: .nom_fonction);
2641:
2642: free((*((struct_fonction *)
2643: (*(*l_element_courant).donnee).objet))
2644: .nom_fonction);
2645:
2646: (*((struct_fonction *) (*(*l_element_courant).donnee)
2647: .objet)).nom_fonction = tampon;
2648:
2649: if (strcmp(tampon, "=") == 0)
2650: {
2651: nombre_egalites++;
2652: }
2653: }
2654:
2655: l_element_courant = (*l_element_courant).suivant;
2656: }
2657:
2658: l_element_courant = (struct_liste_chainee *) element;
2659:
2660: while(l_element_courant != NULL)
2661: {
2662: if (((*(*l_element_courant).donnee).type == FCT)
2663: || ((*(*l_element_courant).donnee).type == NOM))
2664: {
2665: if ((*(*l_element_courant).donnee).type == FCT)
2666: {
2667: if (l_base_liste_fonctions != NULL)
2668: {
2669: l_element_courant_fonctions =
2670: l_base_liste_fonctions;
2671:
2672: while(l_element_courant_fonctions != NULL)
2673: {
2674: if ((fonction_majuscule =
2675: conversion_majuscule(
2676: (*((struct_fonction *)
2677: ((*l_element_courant_fonctions)
2678: .donnee))).nom_fonction)) == NULL)
2679: {
2680: (*s_etat_processus).erreur_systeme =
2681: d_es_allocation_memoire;
2682: (*s_etat_processus)
2683: .traitement_interruptible =
2684: registre_interruption;
2685: return;
2686: }
2687:
2688: if (strcmp(fonction_majuscule,
2689: (*((struct_fonction *)
2690: (*(*l_element_courant).donnee)
2691: .objet)).nom_fonction) == 0)
2692: {
2693: free(fonction_majuscule);
2694: break;
2695: }
2696:
2697: free(fonction_majuscule);
2698: l_element_courant_fonctions =
2699: (*l_element_courant_fonctions)
2700: .suivant;
2701: }
2702:
2703: if (l_element_courant_fonctions != NULL)
2704: {
2705: (*((struct_fonction *)
2706: (*(*l_element_courant)
2707: .donnee).objet)).nombre_arguments =
2708: (*((struct_fonction *)
2709: ((*l_element_courant_fonctions)
2710: .donnee))).nombre_arguments;
2711: }
2712: else
2713: {
2714: (*((struct_fonction *)
2715: (*(*l_element_courant).donnee)
2716: .objet)).nombre_arguments = 0;
2717: }
2718: }
2719: else
2720: {
2721: (*((struct_fonction *)
2722: (*(*l_element_courant).donnee)
2723: .objet)).nombre_arguments = 0;
2724: }
2725: }
2726: else
2727: {
2728: (*((struct_nom *) (*(*l_element_courant).donnee)
2729: .objet)).symbole = d_faux;
2730:
2731: if (l_base_liste_fonctions != NULL)
2732: {
2733: l_element_courant_fonctions =
2734: l_base_liste_fonctions;
2735:
2736: while((strcmp((*((struct_fonction *)
2737: ((*l_element_courant_fonctions)
2738: .donnee))).nom_fonction,
2739: (*((struct_nom *)
2740: (*(*l_element_courant).donnee).objet))
2741: .nom) != 0) &&
2742: ((*l_element_courant_fonctions)
2743: .suivant != NULL))
2744: {
2745: l_element_courant_fonctions =
2746: (*l_element_courant_fonctions)
2747: .suivant;
2748: }
2749:
2750: if (((*l_element_courant_fonctions).suivant !=
2751: NULL) || (strcmp((*((struct_nom *)
2752: (*(*l_element_courant).donnee).objet))
2753: .nom, (*((struct_fonction *)
2754: ((*l_element_courant_fonctions)
2755: .donnee))).nom_fonction) == 0))
2756: {
2757: tampon = (*((struct_nom *)
2758: (*(*l_element_courant)
2759: .donnee).objet)).nom;
2760:
2761: if ((s_sous_objet = (struct_objet *)
2762: malloc(sizeof(
2763: struct_objet))) == NULL)
2764: {
2765: (*s_etat_processus).erreur_systeme =
2766: d_es_allocation_memoire;
2767: (*s_etat_processus)
2768: .traitement_interruptible =
2769: registre_interruption;
2770: return;
2771: }
2772:
2773: initialisation_objet(s_sous_objet);
2774: (*s_sous_objet).type = FCT;
2775:
2776: if (((*s_sous_objet).objet = (void *)
1.8 bertrand 2777: malloc(sizeof(struct_fonction)))
1.1 bertrand 2778: == NULL)
2779: {
2780: (*s_etat_processus).erreur_systeme =
2781: d_es_allocation_memoire;
2782: (*s_etat_processus)
2783: .traitement_interruptible =
2784: registre_interruption;
2785: return;
2786: }
2787:
2788: (*((struct_fonction *) ((*s_sous_objet)
2789: .objet))).nom_fonction = tampon;
2790:
2791: (*((struct_fonction *) ((*s_sous_objet)
2792: .objet))).fonction =
2793: analyse_instruction(
2794: s_etat_processus, tampon);
2795:
2796: (*((struct_fonction *) ((*s_sous_objet)
2797: .objet))).nombre_arguments =
2798: (*((struct_fonction *)
2799: ((*l_element_courant_fonctions)
2800: .donnee))).nombre_arguments;
2801:
2802: free((struct_nom *) (*(*l_element_courant)
2803: .donnee).objet);
2804: free((*l_element_courant).donnee);
2805:
2806: (*l_element_courant).donnee = s_sous_objet;
2807: }
2808: }
2809: }
2810: }
2811:
2812: l_element_courant = (*l_element_courant).suivant;
2813: }
2814: }
2815:
2816: while(l_base_liste_fonctions != NULL)
2817: {
2818: l_element_courant_fonctions = l_base_liste_fonctions;
2819: l_base_liste_fonctions = (*l_base_liste_fonctions).suivant;
2820:
2821: free((*((struct_fonction *) (*l_element_courant_fonctions)
2822: .donnee)).nom_fonction);
2823: free((struct_fonction *) (*l_element_courant_fonctions).donnee);
2824: free(l_element_courant_fonctions);
2825: }
2826:
2827: break;
2828: }
2829:
2830: /*
2831: --------------------------------------------------------------------------------
2832: Chaîne de caractères
2833: --------------------------------------------------------------------------------
2834: */
2835:
2836: case '"' :
2837: {
2838: (*s_objet).type = CHN;
2839:
2840: element = (void *) ((unsigned char *) malloc(
2841: (strlen((*s_etat_processus).instruction_courante) - 1)
2842: * sizeof(unsigned char)));
2843:
2844: if (element == NULL)
2845: {
2846: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2847: (*s_etat_processus).traitement_interruptible =
2848: registre_interruption;
2849: return;
2850: }
2851:
2852: ptr_lecture = (*s_etat_processus).instruction_courante + 1;
2853: ptr_ecriture = (unsigned char *) element;
2854:
2855: while((*ptr_lecture) != d_code_fin_chaine)
2856: {
2857: *ptr_ecriture++ = *ptr_lecture++;
2858: }
2859:
2860: (*(--ptr_ecriture)) = d_code_fin_chaine;
2861:
1.41 bertrand 2862: if (validation_chaine((unsigned char *) element) == d_faux)
2863: {
2864: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2865: (*s_etat_processus).traitement_interruptible =
2866: registre_interruption;
2867:
2868: free(element);
2869: return;
2870: }
2871:
1.1 bertrand 2872: break;
2873: }
2874:
2875: /*
2876: --------------------------------------------------------------------------------
2877: Définition ou tableau
2878: --------------------------------------------------------------------------------
2879: */
2880:
2881: case '<' :
2882: {
2883: if ((*s_etat_processus).instruction_courante[1] == '[')
2884: {
2885: // Tableau
2886:
2887: sauvegarde_longueur_definitions_chainees =
2888: (*s_etat_processus).longueur_definitions_chainees;
2889:
2890: tampon = (unsigned char *) malloc(
2891: (((*s_etat_processus).longueur_definitions_chainees
2892: = strlen((*s_etat_processus).instruction_courante)
2893: + 2) + 1) * sizeof(unsigned char));
2894:
2895: if (tampon == NULL)
2896: {
2897: (*s_etat_processus).erreur_systeme =
2898: d_es_allocation_memoire;
2899: (*s_etat_processus).traitement_interruptible =
2900: registre_interruption;
2901: return;
2902: }
2903:
2904: strcpy(tampon, "<< ");
2905: ptr_ecriture = tampon + 3;
2906: ptr_lecture = (*s_etat_processus).instruction_courante + 2;
2907:
2908: while((*ptr_lecture) != d_code_fin_chaine)
2909: {
2910: *ptr_ecriture++ = *ptr_lecture++;
2911: }
2912:
2913: ptr_ecriture -= 2;
2914: (*ptr_ecriture) = d_code_fin_chaine;
2915: strcat(ptr_ecriture, " >>");
2916:
2917: position_courante = (*s_etat_processus).position_courante;
2918: (*s_etat_processus).position_courante = 0;
2919:
2920: profondeur_initiale = (*s_etat_processus)
2921: .hauteur_pile_operationnelle;
2922:
2923: /*
2924: -- On met les éléments du tableau dans la pile opérationnelle ------------------
2925: */
2926:
2927: (*s_etat_processus).niveau_recursivite++;
2928: definitions_chainees_precedentes = (*s_etat_processus)
2929: .definitions_chainees;
2930: (*s_etat_processus).definitions_chainees = tampon;
2931:
2932: s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
2933: sauvegarde_niveau_courant = (*s_etat_processus).niveau_courant;
2934:
2935: (*s_etat_processus).l_base_pile_systeme = NULL;
2936: empilement_pile_systeme(s_etat_processus);
2937:
2938: if ((*s_etat_processus).erreur_systeme != d_es)
2939: {
2940: (*s_etat_processus).traitement_interruptible =
2941: registre_interruption;
2942: return;
2943: }
2944:
2945: (*(*s_etat_processus).l_base_pile_systeme)
2946: .retour_definition = 'Y';
2947: (*s_etat_processus).niveau_courant = 0;
2948: (*s_etat_processus).autorisation_empilement_programme = 'N';
2949: registre_mode_execution_programme =
2950: (*s_etat_processus).mode_execution_programme;
2951: (*s_etat_processus).mode_execution_programme = 'Y';
2952: (*s_etat_processus).erreur_scrutation = d_faux;
2953:
2954: tampon = (*s_etat_processus).instruction_courante;
2955: nombre_lignes_a_supprimer =
2956: (*s_etat_processus).hauteur_pile_operationnelle;
2957:
2958: if ((*s_etat_processus).profilage == d_vrai)
2959: {
2960: profilage(s_etat_processus, "RPL/2 internals");
2961:
2962: if ((*s_etat_processus).erreur_systeme != d_es)
2963: {
2964: return;
2965: }
2966: }
2967:
1.24 bertrand 2968: registre_recherche_type = (*s_etat_processus).recherche_type;
2969: (*s_etat_processus).recherche_type = 'Y';
2970:
1.34 bertrand 2971: variable_implicite =
2972: (*s_etat_processus).autorisation_nom_implicite;
2973: (*s_etat_processus).autorisation_nom_implicite = 'Y';
2974:
1.1 bertrand 2975: if (sequenceur(s_etat_processus) == d_erreur)
2976: {
1.34 bertrand 2977: (*s_etat_processus).autorisation_nom_implicite =
2978: variable_implicite;
1.24 bertrand 2979: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2980: (*s_etat_processus).recherche_type =
2981: registre_recherche_type;
1.1 bertrand 2982: (*s_etat_processus).mode_execution_programme =
2983: registre_mode_execution_programme;
2984: nombre_lignes_a_supprimer =
2985: (*s_etat_processus).hauteur_pile_operationnelle
2986: - nombre_lignes_a_supprimer;
2987:
2988: for(i = 0; i < nombre_lignes_a_supprimer; i++)
2989: {
2990: if (depilement(s_etat_processus,
2991: &((*s_etat_processus).l_base_pile),
2992: &s_sous_objet) == d_erreur)
2993: {
2994: (*s_etat_processus).traitement_interruptible =
2995: registre_interruption;
2996: return;
2997: }
2998:
2999: liberation(s_etat_processus, s_sous_objet);
3000: }
3001:
3002: (*s_etat_processus).instruction_courante = tampon;
3003:
1.12 bertrand 3004: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 3005: (*s_etat_processus).l_base_pile_systeme =
3006: s_sauvegarde_pile;
3007: (*s_etat_processus).niveau_courant =
3008: sauvegarde_niveau_courant;
3009:
3010: free((*s_etat_processus).definitions_chainees);
3011: (*s_etat_processus).niveau_recursivite--;
3012:
3013: (*s_etat_processus).definitions_chainees =
3014: definitions_chainees_precedentes;
3015: (*s_etat_processus).longueur_definitions_chainees =
3016: sauvegarde_longueur_definitions_chainees;
3017:
3018: (*s_etat_processus).position_courante =
3019: position_courante;
3020:
1.47 ! bertrand 3021: liberation(s_etat_processus, s_objet);
1.1 bertrand 3022:
3023: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3024: (*s_etat_processus).traitement_interruptible =
3025: registre_interruption;
3026: return;
3027: }
3028:
1.34 bertrand 3029: (*s_etat_processus).autorisation_nom_implicite =
3030: variable_implicite;
1.24 bertrand 3031: (*s_etat_processus).recherche_type = registre_recherche_type;
1.1 bertrand 3032: (*s_etat_processus).mode_execution_programme =
3033: registre_mode_execution_programme;
3034:
3035: if ((*s_etat_processus).erreur_scrutation == d_vrai)
3036: {
3037: nombre_lignes_a_supprimer =
3038: (*s_etat_processus).hauteur_pile_operationnelle
3039: - nombre_lignes_a_supprimer;
3040:
3041: for(i = 0; i < nombre_lignes_a_supprimer; i++)
3042: {
3043: if (depilement(s_etat_processus,
3044: &((*s_etat_processus).l_base_pile),
3045: &s_sous_objet) == d_erreur)
3046: {
3047: (*s_etat_processus).traitement_interruptible =
3048: registre_interruption;
3049: return;
3050: }
3051:
3052: liberation(s_etat_processus, s_sous_objet);
3053: }
3054:
3055: (*s_etat_processus).instruction_courante = tampon;
3056:
1.12 bertrand 3057: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 3058: (*s_etat_processus).l_base_pile_systeme =
3059: s_sauvegarde_pile;
3060: (*s_etat_processus).niveau_courant =
3061: sauvegarde_niveau_courant;
3062:
3063: free((*s_etat_processus).definitions_chainees);
3064: (*s_etat_processus).niveau_recursivite--;
3065:
3066: (*s_etat_processus).definitions_chainees =
3067: definitions_chainees_precedentes;
3068: (*s_etat_processus).longueur_definitions_chainees =
3069: sauvegarde_longueur_definitions_chainees;
3070:
3071: (*s_etat_processus).position_courante =
3072: position_courante;
3073:
1.47 ! bertrand 3074: liberation(s_etat_processus, s_objet);
1.1 bertrand 3075:
3076: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3077: (*s_etat_processus).traitement_interruptible =
3078: registre_interruption;
3079: return;
3080: }
3081:
3082: (*s_etat_processus).instruction_courante = tampon;
3083:
3084: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
3085: (*s_etat_processus).niveau_courant =
3086: sauvegarde_niveau_courant;
3087:
3088: free((*s_etat_processus).definitions_chainees);
3089: (*s_etat_processus).definitions_chainees =
3090: definitions_chainees_precedentes;
3091: (*s_etat_processus).longueur_definitions_chainees =
3092: sauvegarde_longueur_definitions_chainees;
3093:
3094: (*s_etat_processus).niveau_recursivite--;
3095:
3096: (*s_etat_processus).position_courante = position_courante;
3097:
3098: /*
3099: -- On relit la pile qui contient des sous-objets contenant les -----------------
3100: -- éléments du tableau ---------------------------------------------------------
3101: */
3102:
3103: profondeur_finale = (*s_etat_processus)
3104: .hauteur_pile_operationnelle;
3105:
3106: nombre_lignes = profondeur_finale - profondeur_initiale;
3107:
1.12 bertrand 3108: if ((element = malloc(sizeof(struct_tableau))) == NULL)
1.1 bertrand 3109: {
3110: (*s_etat_processus).erreur_systeme =
3111: d_es_allocation_memoire;
3112: (*s_etat_processus).traitement_interruptible =
3113: registre_interruption;
3114: return;
3115: }
3116:
3117: (*((struct_tableau *) element)).nombre_elements = nombre_lignes;
3118:
3119: if (((*((struct_tableau *) element)).elements =
3120: malloc(nombre_lignes * sizeof(struct_objet *))) == NULL)
3121: {
3122: (*s_etat_processus).erreur_systeme =
3123: d_es_allocation_memoire;
3124: (*s_etat_processus).traitement_interruptible =
3125: registre_interruption;
3126: return;
3127: }
3128:
3129: for(i = 1; i <= nombre_lignes; i++)
3130: {
3131: if (depilement(s_etat_processus,
3132: &((*s_etat_processus).l_base_pile),
3133: &s_sous_objet) == d_erreur)
3134: {
3135: (*s_etat_processus).traitement_interruptible =
3136: registre_interruption;
3137: return;
3138: }
3139:
3140: (*((struct_tableau *) element)).elements[nombre_lignes - i]
3141: = s_sous_objet;
3142: }
3143:
3144: (*s_objet).type = TBL;
3145:
3146: (*s_etat_processus).traitement_interruptible =
3147: registre_interruption;
3148: }
3149: else
3150: {
3151: // Définition
3152:
3153: if (strlen((*s_etat_processus).instruction_courante) < 5)
3154: {
1.47 ! bertrand 3155: liberation(s_etat_processus, s_objet);
1.1 bertrand 3156:
3157: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3158: (*s_etat_processus).traitement_interruptible =
3159: registre_interruption;
3160: return;
3161: }
3162:
3163: if ((strncmp((*s_etat_processus).instruction_courante, "<< ", 3)
3164: != 0) && (strcmp((*s_etat_processus)
3165: .instruction_courante, "<<") != 0))
3166: {
1.47 ! bertrand 3167: liberation(s_etat_processus, s_objet);
1.1 bertrand 3168:
3169: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3170: (*s_etat_processus).traitement_interruptible =
3171: registre_interruption;
3172: return;
3173: }
3174:
3175: (*s_objet).type = RPN;
3176:
3177: element = (void *) analyse_rpn(s_etat_processus,
3178: (*s_etat_processus).instruction_courante);
3179:
3180: if (element == NULL)
3181: {
3182: if ((*s_etat_processus).erreur_systeme != d_es)
3183: {
3184: (*s_etat_processus).erreur_systeme =
3185: d_es_allocation_memoire;
3186: }
3187:
1.47 ! bertrand 3188: liberation(s_etat_processus, s_objet);
1.12 bertrand 3189:
1.1 bertrand 3190: (*s_etat_processus).traitement_interruptible =
3191: registre_interruption;
3192: return;
3193: }
3194:
3195: l_element_courant = (struct_liste_chainee *) element;
3196:
3197: while(l_element_courant != NULL)
3198: {
3199: if ((*(*l_element_courant).donnee).type == FCT)
3200: {
3201: if (strcmp((*((struct_fonction *) (*(*l_element_courant)
3202: .donnee).objet)).nom_fonction, "=") == 0)
3203: {
3204: nombre_egalites++;
3205: }
3206: }
3207:
3208: l_element_courant = (*l_element_courant).suivant;
3209: }
3210: }
3211:
3212: break;
3213: }
3214:
3215: /*
3216: --------------------------------------------------------------------------------
3217: Entier ou réel
3218: --------------------------------------------------------------------------------
3219: */
3220:
3221: default :
3222: {
3223: if (((*((*s_etat_processus).instruction_courante)) == '-') ||
3224: ((*((*s_etat_processus).instruction_courante)) == '+') ||
3225: (((*((*s_etat_processus).instruction_courante)) >= '0') &&
3226: ((*((*s_etat_processus).instruction_courante))
3227: <= '9')) || ((*((*s_etat_processus).instruction_courante))
3228: == '.'))
3229: {
3230: drapeau_valeur_entiere = ((*((*s_etat_processus)
3231: .instruction_courante)) != '.') ? d_vrai : d_faux;
3232: drapeau_valeur_reelle = d_vrai;
3233:
3234: nombre_points = 0;
3235: nombre_exposants = 0;
3236:
3237: conversion_format(s_etat_processus,
3238: (*s_etat_processus).instruction_courante);
3239:
3240: ptr = (*s_etat_processus).instruction_courante;
3241:
3242: while((*ptr) != d_code_fin_chaine)
3243: {
3244: switch(*ptr)
3245: {
3246: case '0' :
3247: case '1' :
3248: case '2' :
3249: case '3' :
3250: case '4' :
3251: case '5' :
3252: case '6' :
3253: case '7' :
3254: case '8' :
3255: case '9' :
3256: {
3257: break;
3258: }
3259:
3260: // Ne peut survenir qu'après un 'E', un 'e' ou au
3261: // début de la chaîne.
3262: case '+' :
3263: case '-' :
3264: {
3265: if (ptr > (*s_etat_processus).instruction_courante)
3266: {
3267: if (((*(ptr - 1)) != 'e') &&
3268: ((*(ptr - 1)) != 'E'))
3269: {
3270: drapeau_valeur_entiere = d_faux;
3271: drapeau_valeur_reelle = d_faux;
3272: }
3273: }
3274:
3275: break;
3276: }
3277:
3278: // Ne peut que commencer une chaîne, suivre un
3279: // chiffre ou un signe. Ne peut constituer un
3280: // nombre seul.
3281: case '.' :
3282: {
3283: nombre_points++;
3284:
3285: if (ptr > (*s_etat_processus).instruction_courante)
3286: {
3287: switch(*(ptr - 1))
3288: {
3289: case '+' :
3290: case '-' :
3291: case '0' :
3292: case '1' :
3293: case '2' :
3294: case '3' :
3295: case '4' :
3296: case '5' :
3297: case '6' :
3298: case '7' :
3299: case '8' :
3300: case '9' :
3301: {
3302: drapeau_valeur_entiere = d_faux;
3303: break;
3304: }
3305:
3306: default :
3307: {
3308: drapeau_valeur_entiere = d_faux;
3309: drapeau_valeur_reelle = d_faux;
3310: break;
3311: }
3312: }
3313: }
3314: else
3315: {
3316: if ((*(ptr + 1)) == d_code_fin_chaine)
3317: {
3318: drapeau_valeur_entiere = d_faux;
3319: drapeau_valeur_reelle = d_faux;
3320: }
3321: }
3322:
3323: break;
3324: }
3325:
3326: // Ne peut suivre qu'un chiffre ou un point
3327: case 'e' :
3328: case 'E' :
3329: {
3330: nombre_exposants++;
3331:
3332: if (ptr > (*s_etat_processus).instruction_courante)
3333: {
3334: switch(*(ptr - 1))
3335: {
3336: case '0' :
3337: case '1' :
3338: case '2' :
3339: case '3' :
3340: case '4' :
3341: case '5' :
3342: case '6' :
3343: case '7' :
3344: case '8' :
3345: case '9' :
3346: {
3347: drapeau_valeur_entiere = d_faux;
3348: break;
3349: }
3350:
3351: // Le point doit suivre un chiffre
3352: case '.' :
3353: {
3354: if ((ptr - 1) > (*s_etat_processus)
3355: .instruction_courante)
3356: {
3357: switch(*(ptr - 2))
3358: {
3359: case '0' :
3360: case '1' :
3361: case '2' :
3362: case '3' :
3363: case '4' :
3364: case '5' :
3365: case '6' :
3366: case '7' :
3367: case '8' :
3368: case '9' :
3369: {
3370: drapeau_valeur_entiere =
3371: d_faux;
3372: break;
3373: }
3374:
3375: default :
3376: {
3377: drapeau_valeur_entiere =
3378: d_faux;
3379: drapeau_valeur_reelle =
3380: d_faux;
3381: break;
3382: }
3383: }
3384: }
3385: else
3386: {
3387: drapeau_valeur_entiere = d_faux;
3388: drapeau_valeur_reelle = d_faux;
3389: }
3390:
3391: break;
3392: }
3393:
3394: default :
3395: {
3396: drapeau_valeur_entiere = d_faux;
3397: drapeau_valeur_reelle = d_faux;
3398: break;
3399: }
3400: }
3401: }
3402: else
3403: {
3404: drapeau_valeur_entiere = d_faux;
3405: drapeau_valeur_reelle = d_faux;
3406: }
3407:
3408: break;
3409: }
3410:
3411: default :
3412: {
3413: drapeau_valeur_entiere = d_faux;
3414: drapeau_valeur_reelle = d_faux;
3415: break;
3416: }
3417: }
3418:
3419: ptr++;
3420: }
3421:
3422: if ((nombre_points > 1) || (nombre_exposants > 1))
3423: {
3424: drapeau_valeur_reelle = d_faux;
3425: drapeau_valeur_entiere = d_faux;
3426: }
3427: }
3428: else
3429: {
3430: drapeau_valeur_entiere = d_faux;
3431: drapeau_valeur_reelle = d_faux;
3432: }
3433:
3434: if ((drapeau_valeur_reelle == d_faux) &&
3435: (drapeau_valeur_entiere == d_faux))
3436: {
1.23 bertrand 3437: ptr = (*s_etat_processus).instruction_courante;
3438:
3439: while((*ptr) != d_code_fin_chaine)
3440: {
1.25 bertrand 3441: if ((isalnum((*ptr)) == 0) &&
3442: ((*ptr) != '_') &&
3443: ((*ptr) != '$'))
1.23 bertrand 3444: {
1.47 ! bertrand 3445: liberation(s_etat_processus, s_objet);
1.23 bertrand 3446:
3447: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3448: (*s_etat_processus).traitement_interruptible =
3449: registre_interruption;
3450:
3451: return;
3452: }
3453:
3454: ptr++;
3455: }
3456:
1.1 bertrand 3457: (*s_objet).type = NOM;
3458:
3459: element = malloc(sizeof(struct_nom));
3460:
3461: if (element == NULL)
3462: {
3463: (*s_etat_processus).erreur_systeme =
3464: d_es_allocation_memoire;
3465: (*s_etat_processus).traitement_interruptible =
3466: registre_interruption;
3467: return;
3468: }
3469:
3470: (*((struct_nom *) element)).symbole = d_faux;
3471: (*((struct_nom *) element)).nom = ((unsigned char *) malloc(
3472: (strlen((*s_etat_processus)
3473: .instruction_courante) + 1) * sizeof(unsigned char)));
3474:
3475: if ((*((struct_nom *) element)).nom == NULL)
3476: {
3477: (*s_etat_processus).erreur_systeme =
3478: d_es_allocation_memoire;
3479: (*s_etat_processus).traitement_interruptible =
3480: registre_interruption;
3481: return;
3482: }
3483:
3484: strcpy((*((struct_nom *) element)).nom, (*s_etat_processus)
3485: .instruction_courante);
3486: }
3487: else
3488: {
3489: if (drapeau_valeur_entiere == d_faux)
3490: {
3491: (*s_objet).type = REL;
3492:
3493: element = (void *) ((real8 *) malloc(
3494: sizeof(real8)));
3495:
3496: if (element == NULL)
3497: {
3498: (*s_etat_processus).erreur_systeme =
3499: d_es_allocation_memoire;
3500: (*s_etat_processus).traitement_interruptible =
3501: registre_interruption;
3502: return;
3503: }
3504:
3505: nombre_elements_convertis = sscanf(
3506: (*s_etat_processus).instruction_courante, "%lg",
3507: (real8 *) element);
3508:
3509: if (nombre_elements_convertis != 1)
3510: {
3511: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3512: }
3513: }
3514: else
3515: {
1.43 bertrand 3516: // Le format ressemble à un entier mais il peut y avoir
3517: // un dépassement de capacité lors de la conversion.
3518: // On convertit donc en entier et en réel. Si les
3519: // deux conversions donnent le même résultat, on
3520: // considère que la conversion en entier est bonne. Dans
3521: // le cas contraire, on garde la conversion en réel.
1.1 bertrand 3522:
1.43 bertrand 3523: integer8 conversion_entiere;
3524: real8 conversion_reelle;
1.1 bertrand 3525:
1.43 bertrand 3526: if (sscanf((*s_etat_processus).instruction_courante, "%lg",
3527: &conversion_reelle) != 1)
1.1 bertrand 3528: {
1.43 bertrand 3529: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1.1 bertrand 3530: }
3531:
1.43 bertrand 3532: if (sscanf((*s_etat_processus).instruction_courante, "%lld",
3533: &conversion_entiere) != 1)
3534: {
3535: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3536: }
1.1 bertrand 3537:
1.43 bertrand 3538: if (abs(nextafter(conversion_reelle, conversion_entiere)
3539: - conversion_reelle) >= abs(conversion_reelle
3540: - conversion_entiere))
1.1 bertrand 3541: {
1.43 bertrand 3542: (*s_objet).type = INT;
3543:
3544: element = malloc(sizeof(integer8));
3545:
3546: if (element == NULL)
3547: {
3548: (*s_etat_processus).erreur_systeme =
3549: d_es_allocation_memoire;
3550: (*s_etat_processus).traitement_interruptible =
3551: registre_interruption;
3552: return;
3553: }
3554:
3555: (*((integer8 *) element)) = conversion_entiere;
3556: }
3557: else
3558: {
3559: (*s_objet).type = REL;
3560:
3561: element = malloc(sizeof(real8));
3562:
3563: if (element == NULL)
3564: {
3565: (*s_etat_processus).erreur_systeme =
3566: d_es_allocation_memoire;
3567: (*s_etat_processus).traitement_interruptible =
3568: registre_interruption;
3569: return;
3570: }
3571:
3572: (*((real8 *) element)) = conversion_reelle;
1.1 bertrand 3573: }
3574: }
3575: }
3576:
3577: break;
3578: }
3579: }
3580:
3581: (*s_objet).objet = element;
3582:
3583: if (nombre_egalites > 1)
3584: {
3585: liberation(s_etat_processus, s_objet);
3586:
3587: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3588: (*s_etat_processus).traitement_interruptible = registre_interruption;
3589: return;
3590: }
3591:
3592: if (empilement(s_etat_processus,
3593: &((*s_etat_processus).l_base_pile), s_objet) == d_erreur)
3594: {
3595: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1.7 bertrand 3596: (*s_etat_processus).traitement_interruptible =
3597: registre_interruption;
1.1 bertrand 3598: return;
3599: }
3600:
3601: (*s_etat_processus).traitement_interruptible = registre_interruption;
3602: return;
3603: }
3604:
3605:
3606: /*
3607: ================================================================================
3608: Conversion de la virgule
3609: ================================================================================
3610: Entrées : structure sur l'état du processus
3611: --------------------------------------------------------------------------------
3612: Sorties : néant
3613: --------------------------------------------------------------------------------
3614: Effets de bord : néant
3615: ================================================================================
3616: */
3617:
3618: void
3619: conversion_format(struct_processus *s_etat_processus, unsigned char *chaine)
3620: {
3621: unsigned char *ptr;
3622:
3623: /*
3624: --------------------------------------------------------------------------------
3625: Transcription du point en virgule et réciproquement selon l'indicateur 48
3626: --------------------------------------------------------------------------------
3627: */
3628:
3629: if (test_cfsf(s_etat_processus, 48) == d_vrai)
3630: {
3631: ptr = chaine;
3632:
3633: while((*ptr) != d_code_fin_chaine)
3634: {
3635: if ((*ptr) == '.')
3636: {
3637: (*ptr) = ',';
3638: }
3639: else if ((*ptr) == ',')
3640: {
3641: (*ptr) = '.';
3642: }
3643:
3644: ptr++;
3645: }
3646: }
3647:
3648: return;
3649: }
3650:
3651: // vim: ts=4