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