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