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