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